No OneTemporary
Actions

Size

5 MB

Subscribers

None

View Options

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

	Index: trunk/AUTHORS
	===================================================================
	--- trunk/AUTHORS (revision 8903)
	+++ trunk/AUTHORS (revision 8904)
	@@ -1,38 +1,39 @@
	WHIZARD Main Authors:
	contact <whizard@desy.de>

	Wolfgang Kilian <kilian@physik.uni-siegen.de>
	Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	Juergen Reuter <juergen.reuter@desy.de>

	WHIZARD Contributors:
	Timothy Barklow <timb@slac.stanford.edu>
	Mikael Berggren <mikael.berggren@desy.de>
	Simon Brass <simon.brass@desy.de>
	Pia Bredt <pia.bredt@desy.de>
	Bijan Chokoufe Nejad <bijan.chokoufe@desy.de>
	+Marius Hoefer <marius.hoefer@kit.edu>
	Nils Kreher <kreher@physik.uni-siegen.de>
	Krzysztof Mekala <krzysztof.mekala@desy.de>
	Akiya Miyamoto <akiya.miyamoto@kek.jp>
	Vincent Rothe <vincent.rothe@desy.de>
	Christian Speckner <cnspeckn@googlemail.com>
	Pascal Stienemeier <pascal.stienemeier@desy.de>
	Tobias Striegl <striegl@physik.uni-siegen.de>
	Christian Weiss <christian.weiss@desy.de>
	Aleksander Filip Zarnecki <zarnecki@fuw.edu.pl>

	Former WHIZARD team members:
	Fabian Bach
	Vincent Bettaque
	Hans-Werner Boschmann
	Felix Braam
	Christian Fleper
	Daniel Gordo Gomez
	Sebastian Schmidt
	Christian Schwinn
	Marco Sekulla
	So Young Shim
	Florian Staub
	Manuel Utsch
	Daniel Wiesler
	Zhijie Zhao
	Index: trunk/src/qft/qft.nw
	===================================================================
	--- trunk/src/qft/qft.nw (revision 8903)
	+++ trunk/src/qft/qft.nw (revision 8904)
	@@ -1,18813 +1,18961 @@
	%% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: Quantum Field Theory concepts
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Quantum Field Theory Concepts}
	\includemodulegraph{qft}

	The objects and methods defined here implement concepts and data for
	the underlying quantum field theory that we use for computing matrix
	elements and processes.
	\begin{description}
	\item[model\_data]
	Fields and coupling parameters, operators as vertex structures, for
	a specific model.
	\item[model\_testbed]
	Provide hooks to deal with a [[model_data]] extension without
	referencing it explicitly.
	\item[helicities]
	Types and methods for spin density matrices.
	\item[colors]
	Dealing with colored particles, using the color-flow representation.
	\item[flavors]
	PDG codes and particle properties, depends on the model.
	\item[quantum\_numbers]
	Quantum numbers and density matrices for entangled particle systems.
	\end{description}

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Model Data}

	These data represent a specific Lagrangian in numeric terms. That is,
	we have the fields with their quantum numbers, the masses, widths and
	couplings as numerical values, and the vertices as arrays of fields.

	We do not store the relations between coupling parameters. They
	should be represented by expressions for evaluation, implemented as
	Sindarin objects in a distinct data structure. Neither do we need the
	algebraic structure of vertices. The field content of vertices is
	required for the sole purpose of setting up phase space.
	<<[[model_data.f90]]>>=
	<<File header>>

	module model_data

	use, intrinsic :: iso_c_binding !NODEP!

	<<Use kinds>>
	use kinds, only: i8, i32
	use kinds, only: c_default_float
	<<Use strings>>
	use physics_defs, only: UNDEFINED, SCALAR

	<<Standard module head>>

	<<Model data: public>>

	<<Model data: types>>

	interface
	<<Model data: sub interfaces>>
	end interface

	end module model_data
	@ %def model_data
	@
	<<[[model_data_sub.f90]]>>=
	<<File header>>

	submodule (model_data) model_data_s

	use format_defs, only: FMT_19
	use io_units
	use diagnostics
	use md5
	use hashes, only: hash

	implicit none

	<<Model data: parameters>>

	contains

	<<Model data: procedures>>

	end submodule model_data_s

	@ %def model_data_s
	@
	\subsection{Physics Parameters}
	Couplings, masses, and widths are physics parameters. Each parameter
	has a unique name (used, essentially, for diagnostics output and
	debugging) and a value. The value may be a real or a complex number,
	so we provide to implementations of an abstract type.
	<<Model data: public>>=
	public :: modelpar_data_t
	<<Model data: types>>=
	type, abstract :: modelpar_data_t
	private
	type(string_t) :: name
	+ logical :: is_input = .false.
	contains
	<<Model data: par data: TBP>>
	end type modelpar_data_t

	type, extends (modelpar_data_t) :: modelpar_real_t
	private
	real(default) :: value
	end type modelpar_real_t

	type, extends (modelpar_data_t) :: modelpar_complex_t
	private
	complex(default) :: value
	end type modelpar_complex_t

	@ %def modelpar_data_t modelpar_real_t modelpar_complex_t
	@
	Output for diagnostics. Non-advancing.
	<<Model data: par data: TBP>>=
	procedure :: write => par_write
	<<Model data: sub interfaces>>=
	module subroutine par_write (par, unit)
	class(modelpar_data_t), intent(in) :: par
	integer, intent(in), optional :: unit
	end subroutine
	<<Model data: procedures>>=
	module subroutine par_write (par, unit)
	class(modelpar_data_t), intent(in) :: par
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A,1x,A)", advance="no") char (par%name), "= "
	select type (par)
	type is (modelpar_real_t)
	write (u, "(" // FMT_19 // ")", advance="no") par%value
	type is (modelpar_complex_t)
	write (u, "(" // FMT_19 // ",1x,'+',1x," // FMT_19 // ",1x,'I')", &
	advance="no") par%value
	end select
	end subroutine par_write

	@ %def par_write
	@
	Pretty-printed on separate line, with fixed line length
	<<Model data: par data: TBP>>=
	procedure :: show => par_show
	<<Model data: sub interfaces>>=
	module subroutine par_show (par, l, u)
	class(modelpar_data_t), intent(in) :: par
	integer, intent(in) :: l, u
	end subroutine par_show
	<<Model data: procedures>>=
	module subroutine par_show (par, l, u)
	class(modelpar_data_t), intent(in) :: par
	integer, intent(in) :: l, u
	character(len=l) :: buffer
	buffer = par%name
	select type (par)
	type is (modelpar_real_t)
	write (u, "(4x,A,1x,'=',1x," // FMT_19 // ")") buffer, par%value
	type is (modelpar_complex_t)
	write (u, "(4x,A,1x,'=',1x," // FMT_19 // ",1x,'+',1x," &
	// FMT_19 // ",1x,'I')") buffer, par%value
	end select
	end subroutine par_show

	@ %def par_show
	@
	Initialize with name and value. The type depends on the argument
	type. If the type does not match, the value is converted following
	Fortran rules.
	<<Model data: par data: TBP>>=
	generic :: init => modelpar_data_init_real, modelpar_data_init_complex
	procedure, private :: modelpar_data_init_real
	procedure, private :: modelpar_data_init_complex
	<<Model data: sub interfaces>>=
	- module subroutine modelpar_data_init_real (par, name, value)
	+ module subroutine modelpar_data_init_real (par, name, value, is_input)
	class(modelpar_data_t), intent(out) :: par
	type(string_t), intent(in) :: name
	real(default), intent(in) :: value
	+ logical, intent(in), optional :: is_input
	end subroutine modelpar_data_init_real
	- module subroutine modelpar_data_init_complex (par, name, value)
	+ module subroutine modelpar_data_init_complex (par, name, value, is_input)
	class(modelpar_data_t), intent(out) :: par
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: value
	+ logical, intent(in), optional :: is_input
	end subroutine modelpar_data_init_complex
	<<Model data: procedures>>=
	- module subroutine modelpar_data_init_real (par, name, value)
	+ module subroutine modelpar_data_init_real (par, name, value, is_input)
	class(modelpar_data_t), intent(out) :: par
	type(string_t), intent(in) :: name
	real(default), intent(in) :: value
	+ logical, intent(in), optional :: is_input
	+ if (present (is_input)) par%is_input = is_input
	par%name = name
	par = value
	end subroutine modelpar_data_init_real

	- module subroutine modelpar_data_init_complex (par, name, value)
	+ module subroutine modelpar_data_init_complex (par, name, value, is_input)
	class(modelpar_data_t), intent(out) :: par
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: value
	+ logical, intent(in), optional :: is_input
	+ if (present (is_input)) par%is_input = is_input
	par%name = name
	par = value
	end subroutine modelpar_data_init_complex

	@ %def modelpar_data_init_real modelpar_data_init_complex
	@
	Modify the value. We assume that the parameter has been
	initialized. The type (real or complex) must not be changed, and the
	name is also fixed.
	<<Model data: par data: TBP>>=
	generic :: assignment(=) => modelpar_data_set_real, modelpar_data_set_complex
	procedure, private :: modelpar_data_set_real
	procedure, private :: modelpar_data_set_complex
	<<Model data: sub interfaces>>=
	elemental module subroutine modelpar_data_set_real (par, value)
	class(modelpar_data_t), intent(inout) :: par
	real(default), intent(in) :: value
	end subroutine modelpar_data_set_real
	elemental module subroutine modelpar_data_set_complex (par, value)
	class(modelpar_data_t), intent(inout) :: par
	complex(default), intent(in) :: value
	end subroutine modelpar_data_set_complex
	<<Model data: procedures>>=
	elemental module subroutine modelpar_data_set_real (par, value)
	class(modelpar_data_t), intent(inout) :: par
	real(default), intent(in) :: value
	select type (par)
	type is (modelpar_real_t)
	par%value = value
	type is (modelpar_complex_t)
	par%value = value
	end select
	end subroutine modelpar_data_set_real

	elemental module subroutine modelpar_data_set_complex (par, value)
	class(modelpar_data_t), intent(inout) :: par
	complex(default), intent(in) :: value
	select type (par)
	type is (modelpar_real_t)
	par%value = value
	type is (modelpar_complex_t)
	par%value = value
	end select
	end subroutine modelpar_data_set_complex

	@ %def modelpar_data_set_real modelpar_data_set_complex
	@
	Return the parameter name.
	<<Model data: par data: TBP>>=
	procedure :: get_name => modelpar_data_get_name
	<<Model data: sub interfaces>>=
	module function modelpar_data_get_name (par) result (name)
	class(modelpar_data_t), intent(in) :: par
	type(string_t) :: name
	end function modelpar_data_get_name
	<<Model data: procedures>>=
	module function modelpar_data_get_name (par) result (name)
	class(modelpar_data_t), intent(in) :: par
	type(string_t) :: name
	name = par%name
	end function modelpar_data_get_name

	@ %def modelpar_data_get_name
	@
	+Return logical about input information.
	+<<Model data: par data: TBP>>=
	+ procedure :: is_input_par => modelpar_data_is_input_par
	+<<Model data: sub interfaces>>=
	+ module function modelpar_data_is_input_par (par) result (is_input)
	+ class(modelpar_data_t), intent(in) :: par
	+ logical :: is_input
	+ end function modelpar_data_is_input_par
	+<<Model data: procedures>>=
	+ module function modelpar_data_is_input_par (par) result (is_input)
	+ class(modelpar_data_t), intent(in) :: par
	+ logical :: is_input
	+ is_input = par%is_input
	+ end function modelpar_data_is_input_par
	+
	+@ %def modelpar_data_is_input_par
	+@
	+Set logical about input information
	+<<Model data: par data: TBP>>=
	+ procedure :: set_input_par => modelpar_data_set_input_par
	+<<Model data: sub interfaces>>=
	+ module subroutine modelpar_data_set_input_par (par, is_input)
	+ class(modelpar_data_t), intent(inout) :: par
	+ logical, intent(in) :: is_input
	+ end subroutine modelpar_data_set_input_par
	+<<Model data: procedures>>=
	+ module subroutine modelpar_data_set_input_par (par, is_input)
	+ class(modelpar_data_t), intent(inout) :: par
	+ logical, intent(in) :: is_input
	+ par%is_input = is_input
	+ end subroutine modelpar_data_set_input_par
	+
	+@ %def modelpar_data_set_input_par
	+@
	Return the value. In case of a type mismatch, follow Fortran conventions.
	<<Model data: par data: TBP>>=
	procedure, pass :: get_real => modelpar_data_get_real
	procedure, pass :: get_complex => modelpar_data_get_complex
	<<Model data: sub interfaces>>=
	elemental module function modelpar_data_get_real (par) result (value)
	class(modelpar_data_t), intent(in), target :: par
	real(default) :: value
	end function modelpar_data_get_real
	elemental module function modelpar_data_get_complex (par) result (value)
	class(modelpar_data_t), intent(in), target :: par
	complex(default) :: value
	end function modelpar_data_get_complex
	<<Model data: procedures>>=
	elemental module function modelpar_data_get_real (par) result (value)
	class(modelpar_data_t), intent(in), target :: par
	real(default) :: value
	select type (par)
	type is (modelpar_real_t)
	value = par%value
	type is (modelpar_complex_t)
	value = par%value
	end select
	end function modelpar_data_get_real

	elemental module function modelpar_data_get_complex (par) result (value)
	class(modelpar_data_t), intent(in), target :: par
	complex(default) :: value
	select type (par)
	type is (modelpar_real_t)
	value = par%value
	type is (modelpar_complex_t)
	value = par%value
	end select
	end function modelpar_data_get_complex

	@ %def modelpar_data_get_real
	@ %def modelpar_data_get_complex
	@
	Return a pointer to the value. This makes sense only for matching types.
	<<Model data: par data: TBP>>=
	procedure :: get_real_ptr => modelpar_data_get_real_ptr
	procedure :: get_complex_ptr => modelpar_data_get_complex_ptr
	<<Model data: sub interfaces>>=
	module function modelpar_data_get_real_ptr (par) result (ptr)
	class(modelpar_data_t), intent(in), target :: par
	real(default), pointer :: ptr
	end function modelpar_data_get_real_ptr
	module function modelpar_data_get_complex_ptr (par) result (ptr)
	class(modelpar_data_t), intent(in), target :: par
	complex(default), pointer :: ptr
	end function modelpar_data_get_complex_ptr
	<<Model data: procedures>>=
	module function modelpar_data_get_real_ptr (par) result (ptr)
	class(modelpar_data_t), intent(in), target :: par
	real(default), pointer :: ptr
	select type (par)
	type is (modelpar_real_t)
	ptr => par%value
	class default
	ptr => null ()
	end select
	end function modelpar_data_get_real_ptr

	module function modelpar_data_get_complex_ptr (par) result (ptr)
	class(modelpar_data_t), intent(in), target :: par
	complex(default), pointer :: ptr
	select type (par)
	type is (modelpar_complex_t)
	ptr => par%value
	class default
	ptr => null ()
	end select
	end function modelpar_data_get_complex_ptr

	@ %def modelpar_data_get_real_ptr
	@ %def modelpar_data_get_complex_ptr
	@
	\subsection{Field Data}
	The field-data type holds all information that pertains to a particular field
	(or particle) within a particular model. Information such as spin type,
	particle code etc.\ is stored within the object itself, while mass and width
	are associated to parameters, otherwise assumed zero.
	<<Model data: public>>=
	public :: field_data_t
	<<Model data: types>>=
	type :: field_data_t
	private
	type(string_t) :: longname
	integer :: pdg = UNDEFINED
	logical :: visible = .true.
	logical :: parton = .false.
	logical :: gauge = .false.
	logical :: left_handed = .false.
	logical :: right_handed = .false.
	logical :: has_anti = .false.
	logical :: p_is_stable = .true.
	logical :: p_decays_isotropically = .false.
	logical :: p_decays_diagonal = .false.
	logical :: p_has_decay_helicity = .false.
	integer :: p_decay_helicity = 0
	logical :: a_is_stable = .true.
	logical :: a_decays_isotropically = .false.
	logical :: a_decays_diagonal = .false.
	logical :: a_has_decay_helicity = .false.
	integer :: a_decay_helicity = 0
	logical :: p_polarized = .false.
	logical :: a_polarized = .false.
	type(string_t), dimension(:), allocatable :: name, anti
	type(string_t) :: tex_name, tex_anti
	integer :: spin_type = UNDEFINED
	integer :: isospin_type = 1
	integer :: charge_type = 1
	integer :: color_type = 1
	real(default), pointer :: mass_val => null ()
	class(modelpar_data_t), pointer :: mass_data => null ()
	real(default), pointer :: width_val => null ()
	class(modelpar_data_t), pointer :: width_data => null ()
	integer :: multiplicity = 1
	type(string_t), dimension(:), allocatable :: p_decay
	type(string_t), dimension(:), allocatable :: a_decay
	contains
	<<Model data: field data: TBP>>
	end type field_data_t

	@ %def field_data_t
	@ Initialize field data with PDG long name and PDG code. \TeX\
	names should be initialized to avoid issues with accessing
	unallocated string contents.
	<<Model data: field data: TBP>>=
	procedure :: init => field_data_init
	<<Model data: sub interfaces>>=
	module subroutine field_data_init (prt, longname, pdg)
	class(field_data_t), intent(out) :: prt
	type(string_t), intent(in) :: longname
	integer, intent(in) :: pdg
	end subroutine field_data_init
	<<Model data: procedures>>=
	module subroutine field_data_init (prt, longname, pdg)
	class(field_data_t), intent(out) :: prt
	type(string_t), intent(in) :: longname
	integer, intent(in) :: pdg
	prt%longname = longname
	prt%pdg = pdg
	prt%tex_name = ""
	prt%tex_anti = ""
	end subroutine field_data_init

	@ %def field_data_init
	@ Copy quantum numbers from another particle. Do not compute the multiplicity
	yet, because this depends on the association of the [[mass_data]] pointer.
	<<Model data: field data: TBP>>=
	procedure :: copy_from => field_data_copy_from
	<<Model data: sub interfaces>>=
	module subroutine field_data_copy_from (prt, prt_src)
	class(field_data_t), intent(inout) :: prt
	class(field_data_t), intent(in) :: prt_src
	end subroutine field_data_copy_from
	<<Model data: procedures>>=
	module subroutine field_data_copy_from (prt, prt_src)
	class(field_data_t), intent(inout) :: prt
	class(field_data_t), intent(in) :: prt_src
	prt%visible = prt_src%visible
	prt%parton = prt_src%parton
	prt%gauge = prt_src%gauge
	prt%left_handed = prt_src%left_handed
	prt%right_handed = prt_src%right_handed
	prt%p_is_stable = prt_src%p_is_stable
	prt%p_decays_isotropically = prt_src%p_decays_isotropically
	prt%p_decays_diagonal = prt_src%p_decays_diagonal
	prt%p_has_decay_helicity = prt_src%p_has_decay_helicity
	prt%p_decay_helicity = prt_src%p_decay_helicity
	prt%p_decays_diagonal = prt_src%p_decays_diagonal
	prt%a_is_stable = prt_src%a_is_stable
	prt%a_decays_isotropically = prt_src%a_decays_isotropically
	prt%a_decays_diagonal = prt_src%a_decays_diagonal
	prt%a_has_decay_helicity = prt_src%a_has_decay_helicity
	prt%a_decay_helicity = prt_src%a_decay_helicity
	prt%p_polarized = prt_src%p_polarized
	prt%a_polarized = prt_src%a_polarized
	prt%spin_type = prt_src%spin_type
	prt%isospin_type = prt_src%isospin_type
	prt%charge_type = prt_src%charge_type
	prt%color_type = prt_src%color_type
	prt%has_anti = prt_src%has_anti
	if (allocated (prt_src%name)) then
	if (allocated (prt%name)) deallocate (prt%name)
	allocate (prt%name (size (prt_src%name)), source = prt_src%name)
	end if
	if (allocated (prt_src%anti)) then
	if (allocated (prt%anti)) deallocate (prt%anti)
	allocate (prt%anti (size (prt_src%anti)), source = prt_src%anti)
	end if
	prt%tex_name = prt_src%tex_name
	prt%tex_anti = prt_src%tex_anti
	if (allocated (prt_src%p_decay)) then
	if (allocated (prt%p_decay)) deallocate (prt%p_decay)
	allocate (prt%p_decay (size (prt_src%p_decay)), source = prt_src%p_decay)
	end if
	if (allocated (prt_src%a_decay)) then
	if (allocated (prt%a_decay)) deallocate (prt%a_decay)
	allocate (prt%a_decay (size (prt_src%a_decay)), source = prt_src%a_decay)
	end if
	end subroutine field_data_copy_from

	@ %def field_data_copy_from
	@ Set particle quantum numbers.
	<<Model data: field data: TBP>>=
	procedure :: set => field_data_set
	<<Model data: sub interfaces>>=
	module subroutine field_data_set (prt, &
	is_visible, is_parton, is_gauge, is_left_handed, is_right_handed, &
	p_is_stable, p_decays_isotropically, p_decays_diagonal, &
	p_decay_helicity, &
	a_is_stable, a_decays_isotropically, a_decays_diagonal, &
	a_decay_helicity, &
	p_polarized, a_polarized, &
	name, anti, tex_name, tex_anti, &
	spin_type, isospin_type, charge_type, color_type, &
	mass_data, width_data, &
	p_decay, a_decay)
	class(field_data_t), intent(inout) :: prt
	logical, intent(in), optional :: is_visible, is_parton, is_gauge
	logical, intent(in), optional :: is_left_handed, is_right_handed
	logical, intent(in), optional :: p_is_stable
	logical, intent(in), optional :: p_decays_isotropically, p_decays_diagonal
	integer, intent(in), optional :: p_decay_helicity
	logical, intent(in), optional :: a_is_stable
	logical, intent(in), optional :: a_decays_isotropically, a_decays_diagonal
	integer, intent(in), optional :: a_decay_helicity
	logical, intent(in), optional :: p_polarized, a_polarized
	type(string_t), dimension(:), intent(in), optional :: name, anti
	type(string_t), intent(in), optional :: tex_name, tex_anti
	integer, intent(in), optional :: spin_type, isospin_type
	integer, intent(in), optional :: charge_type, color_type
	class(modelpar_data_t), intent(in), pointer, optional :: mass_data, width_data
	type(string_t), dimension(:), intent(in), optional :: p_decay, a_decay
	end subroutine field_data_set
	<<Model data: procedures>>=
	module subroutine field_data_set (prt, &
	is_visible, is_parton, is_gauge, is_left_handed, is_right_handed, &
	p_is_stable, p_decays_isotropically, p_decays_diagonal, &
	p_decay_helicity, &
	a_is_stable, a_decays_isotropically, a_decays_diagonal, &
	a_decay_helicity, &
	p_polarized, a_polarized, &
	name, anti, tex_name, tex_anti, &
	spin_type, isospin_type, charge_type, color_type, &
	mass_data, width_data, &
	p_decay, a_decay)
	class(field_data_t), intent(inout) :: prt
	logical, intent(in), optional :: is_visible, is_parton, is_gauge
	logical, intent(in), optional :: is_left_handed, is_right_handed
	logical, intent(in), optional :: p_is_stable
	logical, intent(in), optional :: p_decays_isotropically, p_decays_diagonal
	integer, intent(in), optional :: p_decay_helicity
	logical, intent(in), optional :: a_is_stable
	logical, intent(in), optional :: a_decays_isotropically, a_decays_diagonal
	integer, intent(in), optional :: a_decay_helicity
	logical, intent(in), optional :: p_polarized, a_polarized
	type(string_t), dimension(:), intent(in), optional :: name, anti
	type(string_t), intent(in), optional :: tex_name, tex_anti
	integer, intent(in), optional :: spin_type, isospin_type
	integer, intent(in), optional :: charge_type, color_type
	class(modelpar_data_t), intent(in), pointer, optional :: mass_data, width_data
	type(string_t), dimension(:), intent(in), optional :: p_decay, a_decay
	if (present (is_visible)) prt%visible = is_visible
	if (present (is_parton)) prt%parton = is_parton
	if (present (is_gauge)) prt%gauge = is_gauge
	if (present (is_left_handed)) prt%left_handed = is_left_handed
	if (present (is_right_handed)) prt%right_handed = is_right_handed
	if (present (p_is_stable)) prt%p_is_stable = p_is_stable
	if (present (p_decays_isotropically)) &
	prt%p_decays_isotropically = p_decays_isotropically
	if (present (p_decays_diagonal)) &
	prt%p_decays_diagonal = p_decays_diagonal
	if (present (p_decay_helicity)) then
	prt%p_has_decay_helicity = .true.
	prt%p_decay_helicity = p_decay_helicity
	end if
	if (present (a_is_stable)) prt%a_is_stable = a_is_stable
	if (present (a_decays_isotropically)) &
	prt%a_decays_isotropically = a_decays_isotropically
	if (present (a_decays_diagonal)) &
	prt%a_decays_diagonal = a_decays_diagonal
	if (present (a_decay_helicity)) then
	prt%a_has_decay_helicity = .true.
	prt%a_decay_helicity = a_decay_helicity
	end if
	if (present (p_polarized)) prt%p_polarized = p_polarized
	if (present (a_polarized)) prt%a_polarized = a_polarized
	if (present (name)) then
	if (allocated (prt%name)) deallocate (prt%name)
	allocate (prt%name (size (name)), source = name)
	end if
	if (present (anti)) then
	if (allocated (prt%anti)) deallocate (prt%anti)
	allocate (prt%anti (size (anti)), source = anti)
	prt%has_anti = .true.
	end if
	if (present (tex_name)) prt%tex_name = tex_name
	if (present (tex_anti)) prt%tex_anti = tex_anti
	if (present (spin_type)) prt%spin_type = spin_type
	if (present (isospin_type)) prt%isospin_type = isospin_type
	if (present (charge_type)) prt%charge_type = charge_type
	if (present (color_type)) prt%color_type = color_type
	if (present (mass_data)) then
	prt%mass_data => mass_data
	if (associated (mass_data)) then
	prt%mass_val => mass_data%get_real_ptr ()
	else
	prt%mass_val => null ()
	end if
	end if
	if (present (width_data)) then
	prt%width_data => width_data
	if (associated (width_data)) then
	prt%width_val => width_data%get_real_ptr ()
	else
	prt%width_val => null ()
	end if
	end if
	if (present (spin_type) .or. present (mass_data)) then
	call prt%set_multiplicity ()
	end if
	if (present (p_decay)) then
	if (allocated (prt%p_decay)) deallocate (prt%p_decay)
	if (size (p_decay) > 0) &
	allocate (prt%p_decay (size (p_decay)), source = p_decay)
	end if
	if (present (a_decay)) then
	if (allocated (prt%a_decay)) deallocate (prt%a_decay)
	if (size (a_decay) > 0) &
	allocate (prt%a_decay (size (a_decay)), source = a_decay)
	end if
	end subroutine field_data_set

	@ %def field_data_set
	@ Calculate the multiplicity given spin type and mass.
	<<Model data: field data: TBP>>=
	procedure, private :: &
	set_multiplicity => field_data_set_multiplicity
	<<Model data: sub interfaces>>=
	module subroutine field_data_set_multiplicity (prt)
	class(field_data_t), intent(inout) :: prt
	end subroutine field_data_set_multiplicity
	<<Model data: procedures>>=
	module subroutine field_data_set_multiplicity (prt)
	class(field_data_t), intent(inout) :: prt
	if (prt%spin_type /= SCALAR) then
	if (associated (prt%mass_data)) then
	prt%multiplicity = prt%spin_type
	else if (prt%left_handed .or. prt%right_handed) then
	prt%multiplicity = 1
	else
	prt%multiplicity = 2
	end if
	end if
	end subroutine field_data_set_multiplicity

	@ %def field_data_set_multiplicity
	@ Set the mass/width value (not the pointer). The mass/width pointer
	must be allocated.
	<<Model data: field data: TBP>>=
	procedure, private :: set_mass => field_data_set_mass
	procedure, private :: set_width => field_data_set_width
	<<Model data: sub interfaces>>=
	module subroutine field_data_set_mass (prt, mass)
	class(field_data_t), intent(inout) :: prt
	real(default), intent(in) :: mass
	end subroutine field_data_set_mass
	module subroutine field_data_set_width (prt, width)
	class(field_data_t), intent(inout) :: prt
	real(default), intent(in) :: width
	end subroutine field_data_set_width
	<<Model data: procedures>>=
	module subroutine field_data_set_mass (prt, mass)
	class(field_data_t), intent(inout) :: prt
	real(default), intent(in) :: mass
	if (associated (prt%mass_val)) prt%mass_val = mass
	end subroutine field_data_set_mass

	module subroutine field_data_set_width (prt, width)
	class(field_data_t), intent(inout) :: prt
	real(default), intent(in) :: width
	if (associated (prt%width_val)) prt%width_val = width
	end subroutine field_data_set_width

	@ %def field_data_set_mass field_data_set_width
	@ Loose ends: name arrays should be allocated.
	<<Model data: field data: TBP>>=
	procedure :: freeze => field_data_freeze
	<<Model data: sub interfaces>>=
	elemental module subroutine field_data_freeze (prt)
	class(field_data_t), intent(inout) :: prt
	end subroutine field_data_freeze
	<<Model data: procedures>>=
	elemental module subroutine field_data_freeze (prt)
	class(field_data_t), intent(inout) :: prt
	if (.not. allocated (prt%name)) allocate (prt%name (0))
	if (.not. allocated (prt%anti)) allocate (prt%anti (0))
	end subroutine field_data_freeze

	@ %def field_data_freeze
	@ Output
	<<Model data: field data: TBP>>=
	procedure :: write => field_data_write
	<<Model data: sub interfaces>>=
	module subroutine field_data_write (prt, unit)
	class(field_data_t), intent(in) :: prt
	integer, intent(in), optional :: unit
	end subroutine field_data_write
	<<Model data: procedures>>=
	module subroutine field_data_write (prt, unit)
	class(field_data_t), intent(in) :: prt
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(3x,A,1x,A)", advance="no") "particle", char (prt%longname)
	write (u, "(1x,I0)", advance="no") prt%pdg
	if (.not. prt%visible) write (u, "(2x,A)", advance="no") "invisible"
	if (prt%parton) write (u, "(2x,A)", advance="no") "parton"
	if (prt%gauge) write (u, "(2x,A)", advance="no") "gauge"
	if (prt%left_handed) write (u, "(2x,A)", advance="no") "left"
	if (prt%right_handed) write (u, "(2x,A)", advance="no") "right"
	write (u, *)
	write (u, "(5x,A)", advance="no") "name"
	if (allocated (prt%name)) then
	do i = 1, size (prt%name)
	write (u, "(1x,A)", advance="no") '"' // char (prt%name(i)) // '"'
	end do
	write (u, *)
	if (prt%has_anti) then
	write (u, "(5x,A)", advance="no") "anti"
	do i = 1, size (prt%anti)
	write (u, "(1x,A)", advance="no") '"' // char (prt%anti(i)) // '"'
	end do
	write (u, *)
	end if
	if (prt%tex_name /= "") then
	write (u, "(5x,A)") &
	"tex_name " // '"' // char (prt%tex_name) // '"'
	end if
	if (prt%has_anti .and. prt%tex_anti /= "") then
	write (u, "(5x,A)") &
	"tex_anti " // '"' // char (prt%tex_anti) // '"'
	end if
	else
	write (u, "(A)") "???"
	end if
	write (u, "(5x,A)", advance="no") "spin "
	select case (mod (prt%spin_type - 1, 2))
	case (0); write (u, "(I0)", advance="no") (prt%spin_type-1) / 2
	case default; write (u, "(I0,A)", advance="no") prt%spin_type-1, "/2"
	end select
	! write (u, "(2x,A,I1,A)") "! [multiplicity = ", prt%multiplicity, "]"
	if (abs (prt%isospin_type) /= 1) then
	write (u, "(2x,A)", advance="no") "isospin "
	select case (mod (abs (prt%isospin_type) - 1, 2))
	case (0); write (u, "(I0)", advance="no") &
	sign (abs (prt%isospin_type) - 1, prt%isospin_type) / 2
	case default; write (u, "(I0,A)", advance="no") &
	sign (abs (prt%isospin_type) - 1, prt%isospin_type), "/2"
	end select
	end if
	if (abs (prt%charge_type) /= 1) then
	write (u, "(2x,A)", advance="no") "charge "
	select case (mod (abs (prt%charge_type) - 1, 3))
	case (0); write (u, "(I0)", advance="no") &
	sign (abs (prt%charge_type) - 1, prt%charge_type) / 3
	case default; write (u, "(I0,A)", advance="no") &
	sign (abs (prt%charge_type) - 1, prt%charge_type), "/3"
	end select
	end if
	if (prt%color_type /= 1) then
	write (u, "(2x,A,I0)", advance="no") "color ", prt%color_type
	end if
	write (u, *)
	if (associated (prt%mass_data)) then
	write (u, "(5x,A)", advance="no") &
	"mass " // char (prt%mass_data%get_name ())
	if (associated (prt%width_data)) then
	write (u, "(2x,A)") &
	"width " // char (prt%width_data%get_name ())
	else
	write (u, *)
	end if
	end if
	call prt%write_decays (u)
	end subroutine field_data_write

	@ %def field_data_write
	@ Write decay and polarization data.
	<<Model data: field data: TBP>>=
	procedure :: write_decays => field_data_write_decays
	<<Model data: sub interfaces>>=
	module subroutine field_data_write_decays (prt, unit)
	class(field_data_t), intent(in) :: prt
	integer, intent(in), optional :: unit
	end subroutine field_data_write_decays
	<<Model data: procedures>>=
	module subroutine field_data_write_decays (prt, unit)
	class(field_data_t), intent(in) :: prt
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	if (.not. prt%p_is_stable) then
	if (allocated (prt%p_decay)) then
	write (u, "(5x,A)", advance="no") "p_decay"
	do i = 1, size (prt%p_decay)
	write (u, "(1x,A)", advance="no") char (prt%p_decay(i))
	end do
	if (prt%p_decays_isotropically) then
	write (u, "(1x,A)", advance="no") "isotropic"
	else if (prt%p_decays_diagonal) then
	write (u, "(1x,A)", advance="no") "diagonal"
	else if (prt%p_has_decay_helicity) then
	write (u, "(1x,A,I0)", advance="no") "helicity = ", &
	prt%p_decay_helicity
	end if
	write (u, *)
	end if
	else if (prt%p_polarized) then
	write (u, "(5x,A)") "p_polarized"
	end if
	if (.not. prt%a_is_stable) then
	if (allocated (prt%a_decay)) then
	write (u, "(5x,A)", advance="no") "a_decay"
	do i = 1, size (prt%a_decay)
	write (u, "(1x,A)", advance="no") char (prt%a_decay(i))
	end do
	if (prt%a_decays_isotropically) then
	write (u, "(1x,A)", advance="no") "isotropic"
	else if (prt%a_decays_diagonal) then
	write (u, "(1x,A)", advance="no") "diagonal"
	else if (prt%a_has_decay_helicity) then
	write (u, "(1x,A,I0)", advance="no") "helicity = ", &
	prt%a_decay_helicity
	end if
	write (u, *)
	end if
	else if (prt%a_polarized) then
	write (u, "(5x,A)") "a_polarized"
	end if
	end subroutine field_data_write_decays

	@ %def field_data_write_decays
	@ Screen version of output.
	<<Model data: field data: TBP>>=
	procedure :: show => field_data_show
	<<Model data: sub interfaces>>=
	module subroutine field_data_show (prt, l, u)
	class(field_data_t), intent(in) :: prt
	integer, intent(in) :: l, u
	end subroutine field_data_show
	<<Model data: procedures>>=
	module subroutine field_data_show (prt, l, u)
	class(field_data_t), intent(in) :: prt
	integer, intent(in) :: l, u
	character(len=l) :: buffer
	integer :: i
	type(string_t), dimension(:), allocatable :: decay
	buffer = prt%get_name (.false.)
	write (u, "(4x,A,1x,I8)", advance="no") buffer, &
	prt%get_pdg ()
	if (prt%is_polarized ()) then
	write (u, "(3x,A)") "polarized"
	else if (.not. prt%is_stable ()) then
	write (u, "(3x,A)", advance="no") "decays:"
	call prt%get_decays (decay)
	do i = 1, size (decay)
	write (u, "(1x,A)", advance="no") char (decay(i))
	end do
	write (u, *)
	else
	write (u, *)
	end if
	if (prt%has_antiparticle ()) then
	buffer = prt%get_name (.true.)
	write (u, "(4x,A,1x,I8)", advance="no") buffer, &
	prt%get_pdg_anti ()
	if (prt%is_polarized (.true.)) then
	write (u, "(3x,A)") "polarized"
	else if (.not. prt%is_stable (.true.)) then
	write (u, "(3x,A)", advance="no") "decays:"
	call prt%get_decays (decay, .true.)
	do i = 1, size (decay)
	write (u, "(1x,A)", advance="no") char (decay(i))
	end do
	write (u, *)
	else
	write (u, *)
	end if
	end if
	end subroutine field_data_show

	@ %def field_data_show
	@ Retrieve data:
	<<Model data: field data: TBP>>=
	procedure :: get_pdg => field_data_get_pdg
	procedure :: get_pdg_anti => field_data_get_pdg_anti
	<<Model data: sub interfaces>>=
	elemental module function field_data_get_pdg (prt) result (pdg)
	integer :: pdg
	class(field_data_t), intent(in) :: prt
	end function field_data_get_pdg
	elemental module function field_data_get_pdg_anti (prt) result (pdg)
	integer :: pdg
	class(field_data_t), intent(in) :: prt
	end function field_data_get_pdg_anti
	<<Model data: procedures>>=
	elemental module function field_data_get_pdg (prt) result (pdg)
	integer :: pdg
	class(field_data_t), intent(in) :: prt
	pdg = prt%pdg
	end function field_data_get_pdg

	elemental module function field_data_get_pdg_anti (prt) result (pdg)
	integer :: pdg
	class(field_data_t), intent(in) :: prt
	if (prt%has_anti) then
	pdg = - prt%pdg
	else
	pdg = prt%pdg
	end if
	end function field_data_get_pdg_anti

	@ %def field_data_get_pdg field_data_get_pdg_anti
	@ Predicates:
	<<Model data: field data: TBP>>=
	procedure :: is_visible => field_data_is_visible
	procedure :: is_parton => field_data_is_parton
	procedure :: is_gauge => field_data_is_gauge
	procedure :: is_left_handed => field_data_is_left_handed
	procedure :: is_right_handed => field_data_is_right_handed
	procedure :: has_antiparticle => field_data_has_antiparticle
	procedure :: is_stable => field_data_is_stable
	+ procedure :: width_is_input => field_data_width_is_input
	+ procedure :: mass_is_input => field_data_mass_is_input
	procedure :: get_decays => field_data_get_decays
	procedure :: decays_isotropically => field_data_decays_isotropically
	procedure :: decays_diagonal => field_data_decays_diagonal
	procedure :: has_decay_helicity => field_data_has_decay_helicity
	procedure :: decay_helicity => field_data_decay_helicity
	procedure :: is_polarized => field_data_is_polarized
	<<Model data: sub interfaces>>=
	elemental module function field_data_is_visible (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	end function field_data_is_visible
	elemental module function field_data_is_parton (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	end function field_data_is_parton
	elemental module function field_data_is_gauge (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	end function field_data_is_gauge
	elemental module function field_data_is_left_handed (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	end function field_data_is_left_handed
	elemental module function field_data_is_right_handed (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	end function field_data_is_right_handed
	elemental module function field_data_has_antiparticle (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	end function field_data_has_antiparticle
	elemental module function field_data_is_stable (prt, anti) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	end function field_data_is_stable
	+ elemental module function field_data_width_is_input (prt) result (flag)
	+ logical :: flag
	+ class(field_data_t), intent(in) :: prt
	+ end function field_data_width_is_input
	+ elemental module function field_data_mass_is_input (prt) result (flag)
	+ logical :: flag
	+ class(field_data_t), intent(in) :: prt
	+ end function field_data_mass_is_input
	module subroutine field_data_get_decays (prt, decay, anti)
	class(field_data_t), intent(in) :: prt
	type(string_t), dimension(:), intent(out), allocatable :: decay
	logical, intent(in), optional :: anti
	end subroutine field_data_get_decays
	elemental module function field_data_decays_isotropically &
	(prt, anti) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	end function field_data_decays_isotropically
	elemental module function field_data_decays_diagonal &
	(prt, anti) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	end function field_data_decays_diagonal
	elemental module function field_data_has_decay_helicity &
	(prt, anti) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	end function field_data_has_decay_helicity
	elemental module function field_data_decay_helicity &
	(prt, anti) result (hel)
	integer :: hel
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	end function field_data_decay_helicity
	elemental module function field_data_is_polarized (prt, anti) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	end function field_data_is_polarized
	<<Model data: procedures>>=
	elemental module function field_data_is_visible (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	flag = prt%visible
	end function field_data_is_visible

	elemental module function field_data_is_parton (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	flag = prt%parton
	end function field_data_is_parton

	elemental module function field_data_is_gauge (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	flag = prt%gauge
	end function field_data_is_gauge

	elemental module function field_data_is_left_handed (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	flag = prt%left_handed
	end function field_data_is_left_handed

	elemental module function field_data_is_right_handed (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	flag = prt%right_handed
	end function field_data_is_right_handed

	elemental module function field_data_has_antiparticle (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	flag = prt%has_anti
	end function field_data_has_antiparticle

	elemental module function field_data_is_stable (prt, anti) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	if (present (anti)) then
	if (anti) then
	flag = prt%a_is_stable
	else
	flag = prt%p_is_stable
	end if
	else
	flag = prt%p_is_stable
	end if
	end function field_data_is_stable
	+ elemental module function field_data_width_is_input (prt) result (flag)
	+ logical :: flag
	+ class(field_data_t), intent(in) :: prt
	+ flag = .false.
	+ if (associated (prt%width_data)) flag = prt%width_data%is_input
	+ end function field_data_width_is_input
	+ elemental module function field_data_mass_is_input (prt) result (flag)
	+ logical :: flag
	+ class(field_data_t), intent(in) :: prt
	+ flag = .false.
	+ if (associated (prt%mass_data)) flag = prt%mass_data%is_input
	+ end function field_data_mass_is_input

	module subroutine field_data_get_decays (prt, decay, anti)
	class(field_data_t), intent(in) :: prt
	type(string_t), dimension(:), intent(out), allocatable :: decay
	logical, intent(in), optional :: anti
	if (present (anti)) then
	if (anti) then
	allocate (decay (size (prt%a_decay)), source = prt%a_decay)
	else
	allocate (decay (size (prt%p_decay)), source = prt%p_decay)
	end if
	else
	allocate (decay (size (prt%p_decay)), source = prt%p_decay)
	end if
	end subroutine field_data_get_decays

	elemental module function field_data_decays_isotropically &
	(prt, anti) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	if (present (anti)) then
	if (anti) then
	flag = prt%a_decays_isotropically
	else
	flag = prt%p_decays_isotropically
	end if
	else
	flag = prt%p_decays_isotropically
	end if
	end function field_data_decays_isotropically

	elemental module function field_data_decays_diagonal &
	(prt, anti) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	if (present (anti)) then
	if (anti) then
	flag = prt%a_decays_diagonal
	else
	flag = prt%p_decays_diagonal
	end if
	else
	flag = prt%p_decays_diagonal
	end if
	end function field_data_decays_diagonal

	elemental module function field_data_has_decay_helicity &
	(prt, anti) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	if (present (anti)) then
	if (anti) then
	flag = prt%a_has_decay_helicity
	else
	flag = prt%p_has_decay_helicity
	end if
	else
	flag = prt%p_has_decay_helicity
	end if
	end function field_data_has_decay_helicity

	elemental module function field_data_decay_helicity &
	(prt, anti) result (hel)
	integer :: hel
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	if (present (anti)) then
	if (anti) then
	hel = prt%a_decay_helicity
	else
	hel = prt%p_decay_helicity
	end if
	else
	hel = prt%p_decay_helicity
	end if
	end function field_data_decay_helicity

	elemental module function field_data_is_polarized (prt, anti) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	logical :: a
	if (present (anti)) then
	a = anti
	else
	a = .false.
	end if
	if (a) then
	flag = prt%a_polarized
	else
	flag = prt%p_polarized
	end if
	end function field_data_is_polarized

	@ %def field_data_is_visible field_data_is_parton
	@ %def field_data_is_gauge
	@ %def field_data_is_left_handed field_data_is_right_handed
	@ %def field_data_has_antiparticle
	@ %def field_data_is_stable
	@ %def field_data_decays_isotropically
	@ %def field_data_decays_diagonal
	@ %def field_data_has_decay_helicity
	@ %def field_data_decay_helicity
	@ %def field_data_polarized
	@ Names. Return the first name in the list (or the first antiparticle name)
	<<Model data: field data: TBP>>=
	procedure :: get_longname => field_data_get_longname
	procedure :: get_name => field_data_get_name
	procedure :: get_name_array => field_data_get_name_array
	<<Model data: sub interfaces>>=
	pure module function field_data_get_longname (prt) result (name)
	type(string_t) :: name
	class(field_data_t), intent(in) :: prt
	end function field_data_get_longname
	pure module function field_data_get_name &
	(prt, is_antiparticle) result (name)
	type(string_t) :: name
	class(field_data_t), intent(in) :: prt
	logical, intent(in) :: is_antiparticle
	end function field_data_get_name
	module subroutine field_data_get_name_array (prt, is_antiparticle, name)
	class(field_data_t), intent(in) :: prt
	logical, intent(in) :: is_antiparticle
	type(string_t), dimension(:), allocatable, intent(inout) :: name
	end subroutine field_data_get_name_array
	<<Model data: procedures>>=
	pure module function field_data_get_longname (prt) result (name)
	type(string_t) :: name
	class(field_data_t), intent(in) :: prt
	name = prt%longname
	end function field_data_get_longname

	pure module function field_data_get_name (prt, is_antiparticle) result (name)
	type(string_t) :: name
	class(field_data_t), intent(in) :: prt
	logical, intent(in) :: is_antiparticle
	name = prt%longname
	if (is_antiparticle) then
	if (prt%has_anti) then
	if (allocated (prt%anti)) then
	if (size(prt%anti) > 0) name = prt%anti(1)
	end if
	else
	if (allocated (prt%name)) then
	if (size (prt%name) > 0) name = prt%name(1)
	end if
	end if
	else
	if (allocated (prt%name)) then
	if (size (prt%name) > 0) name = prt%name(1)
	end if
	end if
	end function field_data_get_name

	module subroutine field_data_get_name_array (prt, is_antiparticle, name)
	class(field_data_t), intent(in) :: prt
	logical, intent(in) :: is_antiparticle
	type(string_t), dimension(:), allocatable, intent(inout) :: name
	if (allocated (name)) deallocate (name)
	if (is_antiparticle) then
	if (prt%has_anti) then
	allocate (name (size (prt%anti)))
	name = prt%anti
	else
	allocate (name (0))
	end if
	else
	allocate (name (size (prt%name)))
	name = prt%name
	end if
	end subroutine field_data_get_name_array

	@ %def field_data_get_name
	@ Same for the \TeX\ name.
	<<Model data: field data: TBP>>=
	procedure :: get_tex_name => field_data_get_tex_name
	<<Model data: sub interfaces>>=
	elemental module function field_data_get_tex_name &
	(prt, is_antiparticle) result (name)
	type(string_t) :: name
	class(field_data_t), intent(in) :: prt
	logical, intent(in) :: is_antiparticle
	end function field_data_get_tex_name
	<<Model data: procedures>>=
	elemental module function field_data_get_tex_name &
	(prt, is_antiparticle) result (name)
	type(string_t) :: name
	class(field_data_t), intent(in) :: prt
	logical, intent(in) :: is_antiparticle
	if (is_antiparticle) then
	if (prt%has_anti) then
	name = prt%tex_anti
	else
	name = prt%tex_name
	end if
	else
	name = prt%tex_name
	end if
	if (name == "") name = prt%get_name (is_antiparticle)
	end function field_data_get_tex_name

	@ %def field_data_get_tex_name
	@ Check if any of the field names matches the given string.
	<<Model data: field data: TBP>>=
	procedure, private :: matches_name => field_data_matches_name
	<<Model data: sub interfaces>>=
	module function field_data_matches_name &
	(field, name, is_antiparticle) result (flag)
	class(field_data_t), intent(in) :: field
	type(string_t), intent(in) :: name
	logical, intent(in) :: is_antiparticle
	logical :: flag
	end function field_data_matches_name
	<<Model data: procedures>>=
	module function field_data_matches_name &
	(field, name, is_antiparticle) result (flag)
	class(field_data_t), intent(in) :: field
	type(string_t), intent(in) :: name
	logical, intent(in) :: is_antiparticle
	logical :: flag
	if (is_antiparticle) then
	if (field%has_anti) then
	flag = any (name == field%anti)
	else
	flag = .false.
	end if
	else
	flag = name == field%longname .or. any (name == field%name)
	end if
	end function field_data_matches_name

	@ %def field_data_matches_name
	@ Quantum numbers
	<<Model data: field data: TBP>>=
	procedure :: get_spin_type => field_data_get_spin_type
	procedure :: get_multiplicity => field_data_get_multiplicity
	procedure :: get_isospin_type => field_data_get_isospin_type
	procedure :: get_charge_type => field_data_get_charge_type
	procedure :: get_color_type => field_data_get_color_type
	<<Model data: sub interfaces>>=
	elemental module function field_data_get_spin_type (prt) result (type)
	integer :: type
	class(field_data_t), intent(in) :: prt
	end function field_data_get_spin_type
	elemental module function field_data_get_multiplicity (prt) result (type)
	integer :: type
	class(field_data_t), intent(in) :: prt
	end function field_data_get_multiplicity
	elemental module function field_data_get_isospin_type (prt) result (type)
	integer :: type
	class(field_data_t), intent(in) :: prt
	end function field_data_get_isospin_type
	elemental module function field_data_get_charge_type (prt) result (type)
	integer :: type
	class(field_data_t), intent(in) :: prt
	end function field_data_get_charge_type
	elemental module function field_data_get_color_type (prt) result (type)
	integer :: type
	class(field_data_t), intent(in) :: prt
	end function field_data_get_color_type
	<<Model data: procedures>>=
	elemental module function field_data_get_spin_type (prt) result (type)
	integer :: type
	class(field_data_t), intent(in) :: prt
	type = prt%spin_type
	end function field_data_get_spin_type

	elemental module function field_data_get_multiplicity (prt) result (type)
	integer :: type
	class(field_data_t), intent(in) :: prt
	type = prt%multiplicity
	end function field_data_get_multiplicity

	elemental module function field_data_get_isospin_type (prt) result (type)
	integer :: type
	class(field_data_t), intent(in) :: prt
	type = prt%isospin_type
	end function field_data_get_isospin_type

	elemental module function field_data_get_charge_type (prt) result (type)
	integer :: type
	class(field_data_t), intent(in) :: prt
	type = prt%charge_type
	end function field_data_get_charge_type

	elemental module function field_data_get_color_type (prt) result (type)
	integer :: type
	class(field_data_t), intent(in) :: prt
	type = prt%color_type
	end function field_data_get_color_type

	@ %def field_data_get_spin_type
	@ %def field_data_get_multiplicity
	@ %def field_data_get_isospin_type
	@ %def field_data_get_charge_type
	@ %def field_data_get_color_type
	@ In the MSSM, neutralinos can have a negative mass. This is
	relevant for computing matrix elements. However, within the
	\whizard\ main program we are interested only in kinematics, therefore
	we return the absolute value of the particle mass. If desired, we can
	extract the sign separately.
	<<Model data: field data: TBP>>=
	procedure :: get_charge => field_data_get_charge
	procedure :: get_isospin => field_data_get_isospin
	procedure :: get_mass => field_data_get_mass
	procedure :: get_mass_sign => field_data_get_mass_sign
	procedure :: get_width => field_data_get_width
	<<Model data: sub interfaces>>=
	elemental module function field_data_get_charge (prt) result (charge)
	real(default) :: charge
	class(field_data_t), intent(in) :: prt
	end function field_data_get_charge
	elemental module function field_data_get_isospin (prt) result (isospin)
	real(default) :: isospin
	class(field_data_t), intent(in) :: prt
	end function field_data_get_isospin
	elemental module function field_data_get_mass (prt) result (mass)
	real(default) :: mass
	class(field_data_t), intent(in) :: prt
	end function field_data_get_mass
	elemental module function field_data_get_mass_sign (prt) result (sgn)
	integer :: sgn
	class(field_data_t), intent(in) :: prt
	end function field_data_get_mass_sign
	elemental module function field_data_get_width (prt) result (width)
	real(default) :: width
	class(field_data_t), intent(in) :: prt
	end function field_data_get_width
	<<Model data: procedures>>=
	elemental module function field_data_get_charge (prt) result (charge)
	real(default) :: charge
	class(field_data_t), intent(in) :: prt
	if (prt%charge_type /= 0) then
	charge = real (sign ((abs(prt%charge_type) - 1), &
	prt%charge_type), default) / 3
	else
	charge = 0
	end if
	end function field_data_get_charge

	elemental module function field_data_get_isospin (prt) result (isospin)
	real(default) :: isospin
	class(field_data_t), intent(in) :: prt
	if (prt%isospin_type /= 0) then
	isospin = real (sign (abs(prt%isospin_type) - 1, &
	prt%isospin_type), default) / 2
	else
	isospin = 0
	end if
	end function field_data_get_isospin

	elemental module function field_data_get_mass (prt) result (mass)
	real(default) :: mass
	class(field_data_t), intent(in) :: prt
	if (associated (prt%mass_val)) then
	mass = abs (prt%mass_val)
	else
	mass = 0
	end if
	end function field_data_get_mass

	elemental module function field_data_get_mass_sign (prt) result (sgn)
	integer :: sgn
	class(field_data_t), intent(in) :: prt
	if (associated (prt%mass_val)) then
	sgn = sign (1._default, prt%mass_val)
	else
	sgn = 0
	end if
	end function field_data_get_mass_sign

	elemental module function field_data_get_width (prt) result (width)
	real(default) :: width
	class(field_data_t), intent(in) :: prt
	if (associated (prt%width_val)) then
	width = prt%width_val
	else
	width = 0
	end if
	end function field_data_get_width

	@ %def field_data_get_charge field_data_get_isospin
	@ %def field_data_get_mass field_data_get_mass_sign
	@ %def field_data_get_width
	@ Find the [[model]] containing the [[PDG]] given two model files.
	<<Model data: public>>=
	public :: find_model
	<<Model data: sub interfaces>>=
	module subroutine find_model (model, PDG, model_A, model_B)
	class(model_data_t), pointer, intent(out) :: model
	integer, intent(in) :: PDG
	class(model_data_t), intent(in), target :: model_A, model_B
	end subroutine find_model
	<<Model data: procedures>>=
	module subroutine find_model (model, PDG, model_A, model_B)
	class(model_data_t), pointer, intent(out) :: model
	integer, intent(in) :: PDG
	class(model_data_t), intent(in), target :: model_A, model_B
	character(len=10) :: buffer
	if (model_A%test_field (PDG)) then
	model => model_A
	else if (model_B%test_field (PDG)) then
	model => model_B
	else
	call model_A%write ()
	call model_B%write ()
	write (buffer, "(I10)") PDG
	call msg_fatal ("Parton " // buffer // &
	" not found in the given model files")
	end if
	end subroutine find_model

	@ %def find_model
	@
	\subsection{Vertex data}
	The vertex object contains an array of particle-data pointers, for
	which we need a separate type. (We could use the flavor type defined
	in another module.)

	The program does not (yet?) make use of vertex definitions, so they
	are not stored here.
	<<Model data: types>>=
	type :: field_data_p
	type(field_data_t), pointer :: p => null ()
	end type field_data_p

	@ %def field_data_p
	<<Model data: types>>=
	type :: vertex_t
	private
	logical :: trilinear
	integer, dimension(:), allocatable :: pdg
	type(field_data_p), dimension(:), allocatable :: prt
	contains
	<<Model data: vertex: TBP>>
	end type vertex_t

	@ %def vertex_t
	<<Model data: vertex: TBP>>=
	procedure :: write => vertex_write
	<<Model data: sub interfaces>>=
	module subroutine vertex_write (vtx, unit)
	class(vertex_t), intent(in) :: vtx
	integer, intent(in), optional :: unit
	end subroutine vertex_write
	<<Model data: procedures>>=
	module subroutine vertex_write (vtx, unit)
	class(vertex_t), intent(in) :: vtx
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(3x,A)", advance="no") "vertex"
	do i = 1, size (vtx%prt)
	if (associated (vtx%prt(i)%p)) then
	write (u, "(1x,A)", advance="no") &
	'"' // char (vtx%prt(i)%p%get_name (vtx%pdg(i) < 0)) &
	// '"'
	else
	write (u, "(1x,I7)", advance="no") vtx%pdg(i)
	end if
	end do
	write (u, *)
	end subroutine vertex_write

	@ %def vertex_write
	@ Initialize using PDG codes. The model is used for finding particle
	data pointers associated with the pdg codes.
	<<Model data: vertex: TBP>>=
	procedure :: init => vertex_init
	<<Model data: sub interfaces>>=
	module subroutine vertex_init (vtx, pdg, model)
	class(vertex_t), intent(out) :: vtx
	integer, dimension(:), intent(in) :: pdg
	type(model_data_t), intent(in), target, optional :: model
	end subroutine vertex_init
	<<Model data: procedures>>=
	module subroutine vertex_init (vtx, pdg, model)
	class(vertex_t), intent(out) :: vtx
	integer, dimension(:), intent(in) :: pdg
	type(model_data_t), intent(in), target, optional :: model
	integer :: i
	allocate (vtx%pdg (size (pdg)))
	allocate (vtx%prt (size (pdg)))
	vtx%trilinear = size (pdg) == 3
	vtx%pdg = pdg
	if (present (model)) then
	do i = 1, size (pdg)
	vtx%prt(i)%p => model%get_field_ptr (pdg(i))
	end do
	end if
	end subroutine vertex_init

	@ %def vertex_init
	@ Copy vertex: we must reassign the field-data pointer to a new model.
	<<Model data: vertex: TBP>>=
	procedure :: copy_from => vertex_copy_from
	<<Model data: sub interfaces>>=
	module subroutine vertex_copy_from (vtx, old_vtx, new_model)
	class(vertex_t), intent(out) :: vtx
	class(vertex_t), intent(in) :: old_vtx
	type(model_data_t), intent(in), target, optional :: new_model
	end subroutine vertex_copy_from
	<<Model data: procedures>>=
	module subroutine vertex_copy_from (vtx, old_vtx, new_model)
	class(vertex_t), intent(out) :: vtx
	class(vertex_t), intent(in) :: old_vtx
	type(model_data_t), intent(in), target, optional :: new_model
	call vtx%init (old_vtx%pdg, new_model)
	end subroutine vertex_copy_from

	@ %def vertex_copy_from
	@ Single-particle lookup: Given a particle code, we return matching
	codes if present, otherwise zero. Actually, we return the
	antiparticles of the matching codes, as appropriate for computing
	splittings.
	<<Model data: vertex: TBP>>=
	procedure :: get_match => vertex_get_match
	<<Model data: sub interfaces>>=
	module subroutine vertex_get_match (vtx, pdg1, pdg2)
	class(vertex_t), intent(in) :: vtx
	integer, intent(in) :: pdg1
	integer, dimension(:), allocatable, intent(out) :: pdg2
	end subroutine vertex_get_match
	<<Model data: procedures>>=
	module subroutine vertex_get_match (vtx, pdg1, pdg2)
	class(vertex_t), intent(in) :: vtx
	integer, intent(in) :: pdg1
	integer, dimension(:), allocatable, intent(out) :: pdg2
	integer :: i, j
	do i = 1, size (vtx%pdg)
	if (vtx%pdg(i) == pdg1) then
	allocate (pdg2 (size (vtx%pdg) - 1))
	do j = 1, i-1
	pdg2(j) = anti (j)
	end do
	do j = i, size (pdg2)
	pdg2(j) = anti (j+1)
	end do
	exit
	end if
	end do
	contains
	function anti (i) result (pdg)
	integer, intent(in) :: i
	integer :: pdg
	if (vtx%prt(i)%p%has_antiparticle ()) then
	pdg = - vtx%pdg(i)
	else
	pdg = vtx%pdg(i)
	end if
	end function anti
	end subroutine vertex_get_match

	@ %def vertex_get_match
	@ To access this from the outside, we create an iterator. The iterator has
	the sole purpose of returning the matching particles for a given array of PDG
	codes.
	<<Model data: public>>=
	public :: vertex_iterator_t
	<<Model data: types>>=
	type :: vertex_iterator_t
	private
	class(model_data_t), pointer :: model => null ()
	integer, dimension(:), allocatable :: pdg
	integer :: vertex_index = 0
	integer :: pdg_index = 0
	logical :: save_pdg_index
	contains
	procedure :: init => vertex_iterator_init
	procedure :: get_next_match => vertex_iterator_get_next_match
	end type vertex_iterator_t

	@ %def vertex_iterator_t
	@ We initialize the iterator for a particular model with the [[pdg]] index of
	the particle we are looking at.
	<<Model data: sub interfaces>>=
	module subroutine vertex_iterator_init (it, model, pdg, save_pdg_index)
	class(vertex_iterator_t), intent(out) :: it
	class(model_data_t), intent(in), target :: model
	integer, dimension(:), intent(in) :: pdg
	logical, intent(in) :: save_pdg_index
	end subroutine vertex_iterator_init
	module subroutine vertex_iterator_get_next_match (it, pdg_match)
	class(vertex_iterator_t), intent(inout) :: it
	integer, dimension(:), allocatable, intent(out) :: pdg_match
	end subroutine vertex_iterator_get_next_match
	<<Model data: procedures>>=
	module subroutine vertex_iterator_init (it, model, pdg, save_pdg_index)
	class(vertex_iterator_t), intent(out) :: it
	class(model_data_t), intent(in), target :: model
	integer, dimension(:), intent(in) :: pdg
	logical, intent(in) :: save_pdg_index
	it%model => model
	allocate (it%pdg (size (pdg)), source = pdg)
	it%save_pdg_index = save_pdg_index
	end subroutine vertex_iterator_init

	module subroutine vertex_iterator_get_next_match (it, pdg_match)
	class(vertex_iterator_t), intent(inout) :: it
	integer, dimension(:), allocatable, intent(out) :: pdg_match
	integer :: i, j
	do i = it%vertex_index + 1, size (it%model%vtx)
	do j = it%pdg_index + 1, size (it%pdg)
	call it%model%vtx(i)%get_match (it%pdg(j), pdg_match)
	if (it%save_pdg_index) then
	if (allocated (pdg_match) .and. j < size (it%pdg)) then
	it%pdg_index = j
	return
	else if (allocated (pdg_match) .and. j == size (it%pdg)) then
	it%vertex_index = i
	it%pdg_index = 0
	return
	end if
	else if (allocated (pdg_match)) then
	it%vertex_index = i
	return
	end if
	end do
	end do
	it%vertex_index = 0
	it%pdg_index = 0
	end subroutine vertex_iterator_get_next_match

	@ %def vertex_iterator_get_next_match
	@
	\subsection{Vertex lookup table}
	The vertex lookup table is a hash table: given two particle codes, we
	check which codes are allowed for the third one.

	The size of the hash table should be large enough that collisions are
	rare. We first select a size based on the number of vertices
	(multiplied by six because all permutations count), with some margin,
	and then choose the smallest integer power of two larger than this.
	<<Model data: parameters>>=
	integer, parameter :: VERTEX_TABLE_SCALE_FACTOR = 60
	@ %def VERTEX_TABLE_SCALE_FACTOR
	<<Model data: procedures>>=
	function vertex_table_size (n_vtx) result (n)
	integer(i32) :: n
	integer, intent(in) :: n_vtx
	integer :: i, s
	s = VERTEX_TABLE_SCALE_FACTOR * n_vtx
	n = 1
	do i = 1, 31
	n = ishft (n, 1)
	s = ishft (s,-1)
	if (s == 0) exit
	end do
	end function vertex_table_size

	@ %def vertex_table_size
	@ The specific hash function takes two particle codes (arbitrary
	integers) and returns a 32-bit integer. It makes use of the universal
	function [[hash]] which operates on a byte array.
	<<Model data: procedures>>=
	function hash2 (pdg1, pdg2)
	integer(i32) :: hash2
	integer, intent(in) :: pdg1, pdg2
	integer(i8), dimension(1) :: mold
	hash2 = hash (transfer ([pdg1, pdg2], mold))
	end function hash2

	@ %def hash2
	@ Each entry in the vertex table stores the two particle codes and an
	array of possibilities for the third code.
	<<Model data: types>>=
	type :: vertex_table_entry_t
	private
	integer :: pdg1 = 0, pdg2 = 0
	integer :: n = 0
	integer, dimension(:), allocatable :: pdg3
	end type vertex_table_entry_t

	@ %def vertex_table_entry_t
	@ The vertex table:
	<<Model data: types>>=
	type :: vertex_table_t
	type(vertex_table_entry_t), dimension(:), allocatable :: entry
	integer :: n_collisions = 0
	integer(i32) :: mask
	contains
	<<Model data: vertex table: TBP>>
	end type vertex_table_t

	@ %def vertex_table_t
	@ Output.
	<<Model data: vertex table: TBP>>=
	procedure :: write => vertex_table_write
	<<Model data: sub interfaces>>=
	module subroutine vertex_table_write (vt, unit)
	class(vertex_table_t), intent(in) :: vt
	integer, intent(in), optional :: unit
	end subroutine vertex_table_write
	<<Model data: procedures>>=
	module subroutine vertex_table_write (vt, unit)
	class(vertex_table_t), intent(in) :: vt
	integer, intent(in), optional :: unit
	integer :: u, i
	character(9) :: size_pdg3
	u = given_output_unit (unit)
	write (u, "(A)") "vertex hash table:"
	write (u, "(A,I7)") " size = ", size (vt%entry)
	write (u, "(A,I7)") " used = ", count (vt%entry%n /= 0)
	write (u, "(A,I7)") " coll = ", vt%n_collisions
	do i = lbound (vt%entry, 1), ubound (vt%entry, 1)
	if (vt%entry(i)%n /= 0) then
	write (size_pdg3, "(I7)") size (vt%entry(i)%pdg3)
	write (u, "(A,1x,I7,1x,A,2(1x,I7),A," // &
	size_pdg3 // "(1x,I7))") &
	" ", i, ":", vt%entry(i)%pdg1, &
	vt%entry(i)%pdg2, "->", vt%entry(i)%pdg3
	end if
	end do
	end subroutine vertex_table_write

	@ %def vertex_table_write
	@ Initializing the vertex table: This is done in two passes. First,
	we scan all permutations for all vertices and count the number of
	entries in each bucket of the hashtable. Then, the buckets are
	allocated accordingly and filled.

	Collision resolution is done by just incrementing the hash value until
	an empty bucket is found. The vertex table size is fixed, since we
	know from the beginning the number of entries.
	<<Model data: vertex table: TBP>>=
	procedure :: init => vertex_table_init
	<<Model data: sub interfaces>>=
	module subroutine vertex_table_init (vt, prt, vtx)
	class(vertex_table_t), intent(out) :: vt
	type(field_data_t), dimension(:), intent(in) :: prt
	type(vertex_t), dimension(:), intent(in) :: vtx
	end subroutine vertex_table_init
	<<Model data: procedures>>=
	module subroutine vertex_table_init (vt, prt, vtx)
	class(vertex_table_t), intent(out) :: vt
	type(field_data_t), dimension(:), intent(in) :: prt
	type(vertex_t), dimension(:), intent(in) :: vtx
	integer :: n_vtx, vt_size, i, p1, p2, p3
	integer, dimension(3) :: p
	n_vtx = size (vtx)
	vt_size = vertex_table_size (count (vtx%trilinear))
	vt%mask = vt_size - 1
	allocate (vt%entry (0:vt_size-1))
	do i = 1, n_vtx
	if (vtx(i)%trilinear) then
	p = vtx(i)%pdg
	p1 = p(1); p2 = p(2)
	call create (hash2 (p1, p2))
	if (p(2) /= p(3)) then
	p2 = p(3)
	call create (hash2 (p1, p2))
	end if
	if (p(1) /= p(2)) then
	p1 = p(2); p2 = p(1)
	call create (hash2 (p1, p2))
	if (p(1) /= p(3)) then
	p2 = p(3)
	call create (hash2 (p1, p2))
	end if
	end if
	if (p(1) /= p(3)) then
	p1 = p(3); p2 = p(1)
	call create (hash2 (p1, p2))
	if (p(1) /= p(2)) then
	p2 = p(2)
	call create (hash2 (p1, p2))
	end if
	end if
	end if
	end do
	do i = 0, vt_size - 1
	allocate (vt%entry(i)%pdg3 (vt%entry(i)%n))
	end do
	vt%entry%n = 0
	do i = 1, n_vtx
	if (vtx(i)%trilinear) then
	p = vtx(i)%pdg
	p1 = p(1); p2 = p(2); p3 = p(3)
	call register (hash2 (p1, p2))
	if (p(2) /= p(3)) then
	p2 = p(3); p3 = p(2)
	call register (hash2 (p1, p2))
	end if
	if (p(1) /= p(2)) then
	p1 = p(2); p2 = p(1); p3 = p(3)
	call register (hash2 (p1, p2))
	if (p(1) /= p(3)) then
	p2 = p(3); p3 = p(1)
	call register (hash2 (p1, p2))
	end if
	end if
	if (p(1) /= p(3)) then
	p1 = p(3); p2 = p(1); p3 = p(2)
	call register (hash2 (p1, p2))
	if (p(1) /= p(2)) then
	p2 = p(2); p3 = p(1)
	call register (hash2 (p1, p2))
	end if
	end if
	end if
	end do
	contains
	recursive subroutine create (hashval)
	integer(i32), intent(in) :: hashval
	integer :: h
	h = iand (hashval, vt%mask)
	if (vt%entry(h)%n == 0) then
	vt%entry(h)%pdg1 = p1
	vt%entry(h)%pdg2 = p2
	vt%entry(h)%n = 1
	else if (vt%entry(h)%pdg1 == p1 .and. vt%entry(h)%pdg2 == p2) then
	vt%entry(h)%n = vt%entry(h)%n + 1
	else
	vt%n_collisions = vt%n_collisions + 1
	call create (hashval + 1)
	end if
	end subroutine create
	recursive subroutine register (hashval)
	integer(i32), intent(in) :: hashval
	integer :: h
	h = iand (hashval, vt%mask)
	if (vt%entry(h)%pdg1 == p1 .and. vt%entry(h)%pdg2 == p2) then
	vt%entry(h)%n = vt%entry(h)%n + 1
	vt%entry(h)%pdg3(vt%entry(h)%n) = p3
	else
	call register (hashval + 1)
	end if
	end subroutine register
	end subroutine vertex_table_init

	@ %def vertex_table_init
	@ Return the array of particle codes that match the given pair.
	<<Model data: vertex table: TBP>>=
	procedure :: match => vertex_table_match
	<<Model data: sub interfaces>>=
	module subroutine vertex_table_match (vt, pdg1, pdg2, pdg3)
	class(vertex_table_t), intent(in) :: vt
	integer, intent(in) :: pdg1, pdg2
	integer, dimension(:), allocatable, intent(out) :: pdg3
	end subroutine vertex_table_match
	<<Model data: procedures>>=
	module subroutine vertex_table_match (vt, pdg1, pdg2, pdg3)
	class(vertex_table_t), intent(in) :: vt
	integer, intent(in) :: pdg1, pdg2
	integer, dimension(:), allocatable, intent(out) :: pdg3
	call match (hash2 (pdg1, pdg2))
	contains
	recursive subroutine match (hashval)
	integer(i32), intent(in) :: hashval
	integer :: h
	h = iand (hashval, vt%mask)
	if (vt%entry(h)%n == 0) then
	allocate (pdg3 (0))
	else if (vt%entry(h)%pdg1 == pdg1 .and. vt%entry(h)%pdg2 == pdg2) then
	allocate (pdg3 (size (vt%entry(h)%pdg3)))
	pdg3 = vt%entry(h)%pdg3
	else
	call match (hashval + 1)
	end if
	end subroutine match
	end subroutine vertex_table_match

	@ %def vertex_table_match
	@ Return true if the triplet is represented as a vertex.
	<<Model data: vertex table: TBP>>=
	procedure :: check => vertex_table_check
	<<Model data: sub interfaces>>=
	module function vertex_table_check (vt, pdg1, pdg2, pdg3) result (flag)
	class(vertex_table_t), intent(in) :: vt
	integer, intent(in) :: pdg1, pdg2, pdg3
	logical :: flag
	end function vertex_table_check
	<<Model data: procedures>>=
	module function vertex_table_check (vt, pdg1, pdg2, pdg3) result (flag)
	class(vertex_table_t), intent(in) :: vt
	integer, intent(in) :: pdg1, pdg2, pdg3
	logical :: flag
	flag = check (hash2 (pdg1, pdg2))
	contains
	recursive function check (hashval) result (flag)
	integer(i32), intent(in) :: hashval
	integer :: h
	logical :: flag
	h = iand (hashval, vt%mask)
	if (vt%entry(h)%n == 0) then
	flag = .false.
	else if (vt%entry(h)%pdg1 == pdg1 .and. vt%entry(h)%pdg2 == pdg2) then
	flag = any (vt%entry(h)%pdg3 == pdg3)
	else
	flag = check (hashval + 1)
	end if
	end function check
	end function vertex_table_check

	@ %def vertex_table_check
	@
	\subsection{Model Data Record}
	This type collects the model data as defined above.

	We deliberately implement the parameter arrays as pointer arrays. We
	thus avoid keeping track of TARGET attributes.

	The [[scheme]] identifier provides meta information. It doesn't give the
	client code an extra parameter, but it tells something about the
	interpretation of the parameters. If the scheme ID is left as default (zero),
	it is ignored.
	<<Model data: public>>=
	public :: model_data_t
	<<Model data: types>>=
	type :: model_data_t
	private
	type(string_t) :: name
	+ type(string_t) :: ufo_path_name
	+ logical :: is_ufo = .false.
	integer :: scheme = 0
	type(modelpar_real_t), dimension(:), pointer :: par_real => null ()
	type(modelpar_complex_t), dimension(:), pointer :: par_complex => null ()
	type(field_data_t), dimension(:), allocatable :: field
	type(vertex_t), dimension(:), allocatable :: vtx
	type(vertex_table_t) :: vt
	contains
	<<Model data: model data: TBP>>
	end type model_data_t

	@ %def model_data_t
	@ Finalizer, deallocate pointer arrays.
	<<Model data: model data: TBP>>=
	procedure :: final => model_data_final
	<<Model data: sub interfaces>>=
	module subroutine model_data_final (model)
	class(model_data_t), intent(inout) :: model
	end subroutine model_data_final
	<<Model data: procedures>>=
	module subroutine model_data_final (model)
	class(model_data_t), intent(inout) :: model
	if (associated (model%par_real)) then
	deallocate (model%par_real)
	end if
	if (associated (model%par_complex)) then
	deallocate (model%par_complex)
	end if
	end subroutine model_data_final

	@ %def model_data_final
	@ Output. The signature matches the signature of the high-level
	[[model_write]] procedure, so some of the options don't actually apply.
	<<Model data: model data: TBP>>=
	procedure :: write => model_data_write
	<<Model data: sub interfaces>>=
	module subroutine model_data_write (model, unit, verbose, &
	show_md5sum, show_variables, show_parameters, &
	show_particles, show_vertices, show_scheme)
	class(model_data_t), intent(in) :: model
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: show_md5sum
	logical, intent(in), optional :: show_variables
	logical, intent(in), optional :: show_parameters
	logical, intent(in), optional :: show_particles
	logical, intent(in), optional :: show_vertices
	logical, intent(in), optional :: show_scheme
	end subroutine model_data_write
	<<Model data: procedures>>=
	module subroutine model_data_write (model, unit, verbose, &
	show_md5sum, show_variables, show_parameters, &
	show_particles, show_vertices, show_scheme)
	class(model_data_t), intent(in) :: model
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: show_md5sum
	logical, intent(in), optional :: show_variables
	logical, intent(in), optional :: show_parameters
	logical, intent(in), optional :: show_particles
	logical, intent(in), optional :: show_vertices
	logical, intent(in), optional :: show_scheme
	logical :: show_sch, show_par, show_prt, show_vtx
	integer :: u, i
	u = given_output_unit (unit)
	show_sch = .false.; if (present (show_scheme)) &
	show_sch = show_scheme
	show_par = .true.; if (present (show_parameters)) &
	show_par = show_parameters
	show_prt = .true.; if (present (show_particles)) &
	show_prt = show_particles
	show_vtx = .true.; if (present (show_vertices)) &
	show_vtx = show_vertices
	if (show_sch) then
	write (u, "(3x,A,1X,I0)") "scheme =", model%scheme
	end if
	if (show_par) then
	do i = 1, size (model%par_real)
	call model%par_real(i)%write (u)
	write (u, "(A)")
	end do
	do i = 1, size (model%par_complex)
	call model%par_complex(i)%write (u)
	write (u, "(A)")
	end do
	end if
	if (show_prt) then
	write (u, "(A)")
	call model%write_fields (u)
	end if
	if (show_vtx) then
	write (u, "(A)")
	call model%write_vertices (u, verbose)
	end if
	end subroutine model_data_write

	@ %def model_data_write
	@ Initialize, allocating pointer arrays. The second version makes a
	deep copy.
	<<Model data: model data: TBP>>=
	generic :: init => model_data_init
	procedure, private :: model_data_init
	<<Model data: sub interfaces>>=
	module subroutine model_data_init (model, name, &
	- n_par_real, n_par_complex, n_field, n_vtx)
	+ n_par_real, n_par_complex, n_field, n_vtx, ufo_path)
	class(model_data_t), intent(out) :: model
	type(string_t), intent(in) :: name
	integer, intent(in) :: n_par_real, n_par_complex
	integer, intent(in) :: n_field
	integer, intent(in) :: n_vtx
	+ type(string_t), intent(in), optional :: ufo_path
	end subroutine model_data_init
	<<Model data: procedures>>=
	module subroutine model_data_init (model, name, &
	- n_par_real, n_par_complex, n_field, n_vtx)
	+ n_par_real, n_par_complex, n_field, n_vtx, ufo_path)
	class(model_data_t), intent(out) :: model
	type(string_t), intent(in) :: name
	integer, intent(in) :: n_par_real, n_par_complex
	integer, intent(in) :: n_field
	integer, intent(in) :: n_vtx
	+ type(string_t), intent(in), optional :: ufo_path
	model%name = name
	+ if (present(ufo_path)) then
	+ model%ufo_path_name = ufo_path
	+ model%is_ufo = .true.
	+ else
	+ model%ufo_path_name = ""
	+ end if
	allocate (model%par_real (n_par_real))
	allocate (model%par_complex (n_par_complex))
	allocate (model%field (n_field))
	allocate (model%vtx (n_vtx))
	end subroutine model_data_init

	@ %def model_data_init
	@ Set the scheme ID.
	<<Model data: model data: TBP>>=
	procedure :: set_scheme_num => model_data_set_scheme_num
	<<Model data: sub interfaces>>=
	module subroutine model_data_set_scheme_num (model, scheme)
	class(model_data_t), intent(inout) :: model
	integer, intent(in) :: scheme
	end subroutine model_data_set_scheme_num
	<<Model data: procedures>>=
	module subroutine model_data_set_scheme_num (model, scheme)
	class(model_data_t), intent(inout) :: model
	integer, intent(in) :: scheme
	model%scheme = scheme
	end subroutine model_data_set_scheme_num

	@ %def model_data_set_scheme_num
	@ Complete model data initialization.
	<<Model data: model data: TBP>>=
	procedure :: freeze_fields => model_data_freeze_fields
	<<Model data: sub interfaces>>=
	module subroutine model_data_freeze_fields (model)
	class(model_data_t), intent(inout) :: model
	end subroutine model_data_freeze_fields
	<<Model data: procedures>>=
	module subroutine model_data_freeze_fields (model)
	class(model_data_t), intent(inout) :: model
	call model%field%freeze ()
	end subroutine model_data_freeze_fields

	@ %def model_data_freeze
	@ Deep copy. The new model should already be initialized, so we do
	not allocate memory.
	<<Model data: model data: TBP>>=
	procedure :: copy_from => model_data_copy
	<<Model data: sub interfaces>>=
	module subroutine model_data_copy (model, src)
	class(model_data_t), intent(inout), target :: model
	class(model_data_t), intent(in), target :: src
	end subroutine model_data_copy
	<<Model data: procedures>>=
	module subroutine model_data_copy (model, src)
	class(model_data_t), intent(inout), target :: model
	class(model_data_t), intent(in), target :: src
	class(modelpar_data_t), pointer :: data, src_data
	integer :: i
	model%scheme = src%scheme
	model%par_real = src%par_real
	model%par_complex = src%par_complex
	do i = 1, size (src%field)
	associate (field => model%field(i), src_field => src%field(i))
	call field%init (src_field%get_longname (), src_field%get_pdg ())
	call field%copy_from (src_field)
	src_data => src_field%mass_data
	if (associated (src_data)) then
	data => model%get_par_data_ptr (src_data%get_name ())
	call field%set (mass_data = data)
	end if
	src_data => src_field%width_data
	if (associated (src_data)) then
	data => model%get_par_data_ptr (src_data%get_name ())
	call field%set (width_data = data)
	end if
	call field%set_multiplicity ()
	end associate
	end do
	do i = 1, size (src%vtx)
	call model%vtx(i)%copy_from (src%vtx(i), model)
	end do
	call model%freeze_vertices ()
	end subroutine model_data_copy

	@ %def model_data_copy
	@ Return the model name and numeric scheme.
	<<Model data: model data: TBP>>=
	procedure :: get_name => model_data_get_name
	procedure :: get_scheme_num => model_data_get_scheme_num
	+ procedure :: is_ufo_model => model_data_is_ufo_model
	+ procedure :: get_ufo_path_name => model_data_get_ufo_path_name
	<<Model data: sub interfaces>>=
	module function model_data_get_name (model) result (name)
	class(model_data_t), intent(in) :: model
	type(string_t) :: name
	end function model_data_get_name
	module function model_data_get_scheme_num (model) result (scheme)
	class(model_data_t), intent(in) :: model
	integer :: scheme
	end function model_data_get_scheme_num
	+ module function model_data_is_ufo_model (model) result (flag)
	+ class(model_data_t), intent(in) :: model
	+ logical :: flag
	+ end function model_data_is_ufo_model
	+ module function model_data_get_ufo_path_name (model) result (ufo_path_name)
	+ class(model_data_t), intent(in) :: model
	+ type(string_t) :: ufo_path_name
	+ end function model_data_get_ufo_path_name
	<<Model data: procedures>>=
	module function model_data_get_name (model) result (name)
	class(model_data_t), intent(in) :: model
	type(string_t) :: name
	name = model%name
	end function model_data_get_name

	module function model_data_get_scheme_num (model) result (scheme)
	class(model_data_t), intent(in) :: model
	integer :: scheme
	scheme = model%scheme
	end function model_data_get_scheme_num

	+ module function model_data_is_ufo_model (model) result (flag)
	+ class(model_data_t), intent(in) :: model
	+ logical :: flag
	+ flag = model%is_ufo
	+ end function model_data_is_ufo_model
	+
	+ module function model_data_get_ufo_path_name (model) result (ufo_path_name)
	+ class(model_data_t), intent(in) :: model
	+ type(string_t) :: ufo_path_name
	+ ufo_path_name = model%ufo_path_name
	+ end function model_data_get_ufo_path_name
	+
	@ %def model_data_get_name
	@ %def model_data_get_scheme
	@ Retrieve a MD5 sum for the current model parameter values and
	decay/polarization settings. This is
	done by writing them to a temporary file, using a standard format. If the
	model scheme is nonzero, it is also written.
	<<Model data: model data: TBP>>=
	procedure :: get_parameters_md5sum => model_data_get_parameters_md5sum
	<<Model data: sub interfaces>>=
	module function model_data_get_parameters_md5sum (model) result (par_md5sum)
	character(32) :: par_md5sum
	class(model_data_t), intent(in) :: model
	end function model_data_get_parameters_md5sum
	<<Model data: procedures>>=
	module function model_data_get_parameters_md5sum (model) result (par_md5sum)
	character(32) :: par_md5sum
	class(model_data_t), intent(in) :: model
	real(default), dimension(:), allocatable :: par
	type(field_data_t), pointer :: field
	integer :: unit, i
	allocate (par (model%get_n_real ()))
	call model%real_parameters_to_array (par)
	unit = free_unit ()
	open (unit, status="scratch", action="readwrite")
	if (model%scheme /= 0) write (unit, "(I0)") model%scheme
	write (unit, "(" // FMT_19 // ")") par
	do i = 1, model%get_n_field ()
	field => model%get_field_ptr_by_index (i)
	if (.not. field%is_stable (.false.) .or. .not. field%is_stable (.true.) &
	.or. field%is_polarized (.false.) .or. field%is_polarized (.true.))&
	then
	write (unit, "(3x,A)") char (field%get_longname ())
	call field%write_decays (unit)
	end if
	end do
	rewind (unit)
	par_md5sum = md5sum (unit)
	close (unit)
	end function model_data_get_parameters_md5sum

	@ %def model_get_parameters_md5sum
	@ Return the MD5 sum. This is a placeholder, to be overwritten
	for the complete model definition.
	<<Model data: model data: TBP>>=
	procedure :: get_md5sum => model_data_get_md5sum
	<<Model data: sub interfaces>>=
	module function model_data_get_md5sum (model) result (md5sum)
	class(model_data_t), intent(in) :: model
	character(32) :: md5sum
	end function model_data_get_md5sum
	<<Model data: procedures>>=
	module function model_data_get_md5sum (model) result (md5sum)
	class(model_data_t), intent(in) :: model
	character(32) :: md5sum
	md5sum = model%get_parameters_md5sum ()
	end function model_data_get_md5sum

	@ %def model_data_get_md5sum
	@ Initialize a real or complex parameter.
	<<Model data: model data: TBP>>=
	generic :: init_par => model_data_init_par_real, model_data_init_par_complex
	procedure, private :: model_data_init_par_real
	procedure, private :: model_data_init_par_complex
	<<Model data: sub interfaces>>=
	module subroutine model_data_init_par_real (model, i, name, value)
	class(model_data_t), intent(inout) :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	real(default), intent(in) :: value
	end subroutine model_data_init_par_real
	module subroutine model_data_init_par_complex (model, i, name, value)
	class(model_data_t), intent(inout) :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: value
	end subroutine model_data_init_par_complex
	<<Model data: procedures>>=
	module subroutine model_data_init_par_real (model, i, name, value)
	class(model_data_t), intent(inout) :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	real(default), intent(in) :: value
	call model%par_real(i)%init (name, value)
	end subroutine model_data_init_par_real

	module subroutine model_data_init_par_complex (model, i, name, value)
	class(model_data_t), intent(inout) :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: value
	call model%par_complex(i)%init (name, value)
	end subroutine model_data_init_par_complex

	@ %def model_data_init_par_real model_data_init_par_complex
	@ After initialization, return size of parameter array.
	<<Model data: model data: TBP>>=
	procedure :: get_n_real => model_data_get_n_real
	procedure :: get_n_complex => model_data_get_n_complex
	<<Model data: sub interfaces>>=
	module function model_data_get_n_real (model) result (n)
	class(model_data_t), intent(in) :: model
	integer :: n
	end function model_data_get_n_real
	module function model_data_get_n_complex (model) result (n)
	class(model_data_t), intent(in) :: model
	integer :: n
	end function model_data_get_n_complex
	<<Model data: procedures>>=
	module function model_data_get_n_real (model) result (n)
	class(model_data_t), intent(in) :: model
	integer :: n
	n = size (model%par_real)
	end function model_data_get_n_real

	module function model_data_get_n_complex (model) result (n)
	class(model_data_t), intent(in) :: model
	integer :: n
	n = size (model%par_complex)
	end function model_data_get_n_complex

	@ %def model_data_get_n_real
	@ %def model_data_get_n_complex
	@ After initialization, extract the whole parameter array.
	<<Model data: model data: TBP>>=
	procedure :: real_parameters_to_array &
	=> model_data_real_par_to_array
	procedure :: complex_parameters_to_array &
	=> model_data_complex_par_to_array
	<<Model data: sub interfaces>>=
	module subroutine model_data_real_par_to_array (model, array)
	class(model_data_t), intent(in) :: model
	real(default), dimension(:), intent(inout) :: array
	end subroutine model_data_real_par_to_array
	module subroutine model_data_complex_par_to_array (model, array)
	class(model_data_t), intent(in) :: model
	complex(default), dimension(:), intent(inout) :: array
	end subroutine model_data_complex_par_to_array
	<<Model data: procedures>>=
	module subroutine model_data_real_par_to_array (model, array)
	class(model_data_t), intent(in) :: model
	real(default), dimension(:), intent(inout) :: array
	array = model%par_real%get_real ()
	end subroutine model_data_real_par_to_array

	module subroutine model_data_complex_par_to_array (model, array)
	class(model_data_t), intent(in) :: model
	complex(default), dimension(:), intent(inout) :: array
	array = model%par_complex%get_complex ()
	end subroutine model_data_complex_par_to_array

	@ %def model_data_real_par_to_array
	@ %def model_data_complex_par_to_array
	@ After initialization, set the whole parameter array.
	<<Model data: model data: TBP>>=
	procedure :: real_parameters_from_array &
	=> model_data_real_par_from_array
	procedure :: complex_parameters_from_array &
	=> model_data_complex_par_from_array
	<<Model data: sub interfaces>>=
	module subroutine model_data_real_par_from_array (model, array)
	class(model_data_t), intent(inout) :: model
	real(default), dimension(:), intent(in) :: array
	end subroutine model_data_real_par_from_array
	module subroutine model_data_complex_par_from_array (model, array)
	class(model_data_t), intent(inout) :: model
	complex(default), dimension(:), intent(in) :: array
	end subroutine model_data_complex_par_from_array
	<<Model data: procedures>>=
	module subroutine model_data_real_par_from_array (model, array)
	class(model_data_t), intent(inout) :: model
	real(default), dimension(:), intent(in) :: array
	model%par_real = array
	end subroutine model_data_real_par_from_array

	module subroutine model_data_complex_par_from_array (model, array)
	class(model_data_t), intent(inout) :: model
	complex(default), dimension(:), intent(in) :: array
	model%par_complex = array
	end subroutine model_data_complex_par_from_array

	@ %def model_data_real_par_from_array
	@ %def model_data_complex_par_from_array
	@ Analogous, for a C parameter array.
	<<Model data: model data: TBP>>=
	procedure :: real_parameters_to_c_array &
	=> model_data_real_par_to_c_array
	<<Model data: sub interfaces>>=
	module subroutine model_data_real_par_to_c_array (model, array)
	class(model_data_t), intent(in) :: model
	real(c_default_float), dimension(:), intent(inout) :: array
	end subroutine model_data_real_par_to_c_array
	<<Model data: procedures>>=
	module subroutine model_data_real_par_to_c_array (model, array)
	class(model_data_t), intent(in) :: model
	real(c_default_float), dimension(:), intent(inout) :: array
	array = model%par_real%get_real ()
	end subroutine model_data_real_par_to_c_array

	@ %def model_data_real_par_to_c_array
	@ After initialization, set the whole parameter array.
	<<Model data: model data: TBP>>=
	procedure :: real_parameters_from_c_array &
	=> model_data_real_par_from_c_array
	<<Model data: sub interfaces>>=
	module subroutine model_data_real_par_from_c_array (model, array)
	class(model_data_t), intent(inout) :: model
	real(c_default_float), dimension(:), intent(in) :: array
	end subroutine model_data_real_par_from_c_array
	<<Model data: procedures>>=
	module subroutine model_data_real_par_from_c_array (model, array)
	class(model_data_t), intent(inout) :: model
	real(c_default_float), dimension(:), intent(in) :: array
	model%par_real = real (array, default)
	end subroutine model_data_real_par_from_c_array

	@ %def model_data_real_par_from_c_array
	@ After initialization, get pointer to a real or complex parameter,
	directly by index.
	<<Model data: model data: TBP>>=
	procedure :: get_par_real_ptr => model_data_get_par_real_ptr_index
	procedure :: get_par_complex_ptr => model_data_get_par_complex_ptr_index
	<<Model data: sub interfaces>>=
	module function model_data_get_par_real_ptr_index (model, i) result (ptr)
	- class(model_data_t), intent(inout) :: model
	+ class(model_data_t), intent(in) :: model
	integer, intent(in) :: i
	class(modelpar_data_t), pointer :: ptr
	end function model_data_get_par_real_ptr_index
	module function model_data_get_par_complex_ptr_index (model, i) result (ptr)
	- class(model_data_t), intent(inout) :: model
	+ class(model_data_t), intent(in) :: model
	integer, intent(in) :: i
	class(modelpar_data_t), pointer :: ptr
	end function model_data_get_par_complex_ptr_index
	<<Model data: procedures>>=
	module function model_data_get_par_real_ptr_index (model, i) result (ptr)
	- class(model_data_t), intent(inout) :: model
	+ class(model_data_t), intent(in) :: model
	integer, intent(in) :: i
	class(modelpar_data_t), pointer :: ptr
	ptr => model%par_real(i)
	end function model_data_get_par_real_ptr_index

	module function model_data_get_par_complex_ptr_index (model, i) result (ptr)
	- class(model_data_t), intent(inout) :: model
	+ class(model_data_t), intent(in) :: model
	integer, intent(in) :: i
	class(modelpar_data_t), pointer :: ptr
	ptr => model%par_complex(i)
	end function model_data_get_par_complex_ptr_index

	@ %def model_data_get_par_real_ptr model_data_get_par_complex_ptr
	@ After initialization, get pointer to a parameter by name.
	<<Model data: model data: TBP>>=
	procedure :: get_par_data_ptr => model_data_get_par_data_ptr_name
	<<Model data: sub interfaces>>=
	module function model_data_get_par_data_ptr_name (model, name) result (ptr)
	class(model_data_t), intent(in) :: model
	type(string_t), intent(in) :: name
	class(modelpar_data_t), pointer :: ptr
	end function model_data_get_par_data_ptr_name
	<<Model data: procedures>>=
	module function model_data_get_par_data_ptr_name (model, name) result (ptr)
	class(model_data_t), intent(in) :: model
	type(string_t), intent(in) :: name
	class(modelpar_data_t), pointer :: ptr
	integer :: i
	do i = 1, size (model%par_real)
	if (model%par_real(i)%name == name) then
	ptr => model%par_real(i)
	return
	end if
	end do
	do i = 1, size (model%par_complex)
	if (model%par_complex(i)%name == name) then
	ptr => model%par_complex(i)
	return
	end if
	end do
	ptr => null ()
	end function model_data_get_par_data_ptr_name

	@ %def model_data_get_par_data_ptr
	@ Return the value by name. Again, type conversion is allowed.
	<<Model data: model data: TBP>>=
	procedure :: get_real => model_data_get_par_real_value
	procedure :: get_complex => model_data_get_par_complex_value
	<<Model data: sub interfaces>>=
	module function model_data_get_par_real_value (model, name) result (value)
	class(model_data_t), intent(in) :: model
	type(string_t), intent(in) :: name
	real(default) :: value
	end function model_data_get_par_real_value
	module function model_data_get_par_complex_value &
	(model, name) result (value)
	class(model_data_t), intent(in) :: model
	type(string_t), intent(in) :: name
	complex(default) :: value
	end function model_data_get_par_complex_value
	<<Model data: procedures>>=
	module function model_data_get_par_real_value (model, name) result (value)
	class(model_data_t), intent(in) :: model
	type(string_t), intent(in) :: name
	class(modelpar_data_t), pointer :: par
	real(default) :: value
	par => model%get_par_data_ptr (name)
	value = par%get_real ()
	end function model_data_get_par_real_value

	module function model_data_get_par_complex_value (model, name) result (value)
	class(model_data_t), intent(in) :: model
	type(string_t), intent(in) :: name
	class(modelpar_data_t), pointer :: par
	complex(default) :: value
	par => model%get_par_data_ptr (name)
	value = par%get_complex ()
	end function model_data_get_par_complex_value

	@ %def model_data_get_real
	@ %def model_data_get_complex
	@ Modify a real or complex parameter.
	<<Model data: model data: TBP>>=
	generic :: set_par => model_data_set_par_real, model_data_set_par_complex
	procedure, private :: model_data_set_par_real
	procedure, private :: model_data_set_par_complex
	<<Model data: sub interfaces>>=
	module subroutine model_data_set_par_real (model, name, value)
	class(model_data_t), intent(inout) :: model
	type(string_t), intent(in) :: name
	real(default), intent(in) :: value
	end subroutine model_data_set_par_real
	module subroutine model_data_set_par_complex (model, name, value)
	class(model_data_t), intent(inout) :: model
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: value
	end subroutine model_data_set_par_complex
	<<Model data: procedures>>=
	module subroutine model_data_set_par_real (model, name, value)
	class(model_data_t), intent(inout) :: model
	type(string_t), intent(in) :: name
	real(default), intent(in) :: value
	class(modelpar_data_t), pointer :: par
	par => model%get_par_data_ptr (name)
	par = value
	end subroutine model_data_set_par_real

	module subroutine model_data_set_par_complex (model, name, value)
	class(model_data_t), intent(inout) :: model
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: value
	class(modelpar_data_t), pointer :: par
	par => model%get_par_data_ptr (name)
	par = value
	end subroutine model_data_set_par_complex

	@ %def model_data_set_par_real model_data_set_par_complex
	@ List all fields in the model.
	<<Model data: model data: TBP>>=
	procedure :: write_fields => model_data_write_fields
	<<Model data: sub interfaces>>=
	module subroutine model_data_write_fields (model, unit)
	class(model_data_t), intent(in) :: model
	integer, intent(in), optional :: unit
	end subroutine model_data_write_fields
	<<Model data: procedures>>=
	module subroutine model_data_write_fields (model, unit)
	class(model_data_t), intent(in) :: model
	integer, intent(in), optional :: unit
	integer :: i
	do i = 1, size (model%field)
	call model%field(i)%write (unit)
	end do
	end subroutine model_data_write_fields

	@ %def model_data_write_fields
	@ After initialization, return number of fields (particles):
	<<Model data: model data: TBP>>=
	procedure :: get_n_field => model_data_get_n_field
	<<Model data: sub interfaces>>=
	module function model_data_get_n_field (model) result (n)
	class(model_data_t), intent(in) :: model
	integer :: n
	end function model_data_get_n_field
	<<Model data: procedures>>=
	module function model_data_get_n_field (model) result (n)
	class(model_data_t), intent(in) :: model
	integer :: n
	n = size (model%field)
	end function model_data_get_n_field

	@ %def model_data_get_n_field
	@ Return the PDG code of a field. The field is identified by name or
	by index. If the field is not found, return zero.
	<<Model data: model data: TBP>>=
	generic :: get_pdg => &
	model_data_get_field_pdg_index, &
	model_data_get_field_pdg_name
	procedure, private :: model_data_get_field_pdg_index
	procedure, private :: model_data_get_field_pdg_name
	<<Model data: sub interfaces>>=
	module function model_data_get_field_pdg_index (model, i) result (pdg)
	class(model_data_t), intent(in) :: model
	integer, intent(in) :: i
	integer :: pdg
	end function model_data_get_field_pdg_index
	module function model_data_get_field_pdg_name &
	(model, name, check) result (pdg)
	class(model_data_t), intent(in) :: model
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: check
	integer :: pdg
	end function model_data_get_field_pdg_name
	<<Model data: procedures>>=
	module function model_data_get_field_pdg_index (model, i) result (pdg)
	class(model_data_t), intent(in) :: model
	integer, intent(in) :: i
	integer :: pdg
	pdg = model%field(i)%get_pdg ()
	end function model_data_get_field_pdg_index

	module function model_data_get_field_pdg_name &
	(model, name, check) result (pdg)
	class(model_data_t), intent(in) :: model
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: check
	integer :: pdg
	integer :: i
	do i = 1, size (model%field)
	associate (field => model%field(i))
	if (field%matches_name (name, .false.)) then
	pdg = field%get_pdg ()
	return
	else if (field%matches_name (name, .true.)) then
	pdg = - field%get_pdg ()
	return
	end if
	end associate
	end do
	pdg = 0
	call model%field_error (check, name)
	end function model_data_get_field_pdg_name

	@ %def model_data_get_field_pdg
	@ Return an array of all PDG codes, including antiparticles. The antiparticle
	are sorted after all particles.
	<<Model data: model data: TBP>>=
	procedure :: get_all_pdg => model_data_get_all_pdg
	<<Model data: sub interfaces>>=
	module subroutine model_data_get_all_pdg (model, pdg)
	class(model_data_t), intent(in) :: model
	integer, dimension(:), allocatable, intent(inout) :: pdg
	end subroutine model_data_get_all_pdg
	<<Model data: procedures>>=
	module subroutine model_data_get_all_pdg (model, pdg)
	class(model_data_t), intent(in) :: model
	integer, dimension(:), allocatable, intent(inout) :: pdg
	integer :: n0, n1, i, k
	n0 = size (model%field)
	n1 = n0 + count (model%field%has_antiparticle ())
	allocate (pdg (n1))
	pdg(1:n0) = model%field%get_pdg ()
	k = n0
	do i = 1, size (model%field)
	associate (field => model%field(i))
	if (field%has_antiparticle ()) then
	k = k + 1
	pdg(k) = - field%get_pdg ()
	end if
	end associate
	end do
	end subroutine model_data_get_all_pdg

	@ %def model_data_get_all_pdg
	@ Return pointer to the field array.
	<<Model data: model data: TBP>>=
	procedure :: get_field_array_ptr => model_data_get_field_array_ptr
	<<Model data: sub interfaces>>=
	module function model_data_get_field_array_ptr (model) result (ptr)
	class(model_data_t), intent(in), target :: model
	type(field_data_t), dimension(:), pointer :: ptr
	end function model_data_get_field_array_ptr
	<<Model data: procedures>>=
	module function model_data_get_field_array_ptr (model) result (ptr)
	class(model_data_t), intent(in), target :: model
	type(field_data_t), dimension(:), pointer :: ptr
	ptr => model%field
	end function model_data_get_field_array_ptr

	@ %def model_data_get_field_array_ptr
	@ Return pointer to a field. The identifier should be the unique long
	name, the PDG code, or the index.

	We can issue an error message, if the [[check]] flag is set. We never return
	an error if the PDG code is zero, this yields just a null pointer.
	<<Model data: model data: TBP>>=
	generic :: get_field_ptr => &
	model_data_get_field_ptr_name, &
	model_data_get_field_ptr_pdg
	procedure, private :: model_data_get_field_ptr_name
	procedure, private :: model_data_get_field_ptr_pdg
	procedure :: get_field_ptr_by_index => model_data_get_field_ptr_index
	<<Model data: sub interfaces>>=
	module function model_data_get_field_ptr_name &
	(model, name, check) result (ptr)
	class(model_data_t), intent(in), target :: model
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: check
	type(field_data_t), pointer :: ptr
	end function model_data_get_field_ptr_name
	module function model_data_get_field_ptr_pdg &
	(model, pdg, check) result (ptr)
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: pdg
	logical, intent(in), optional :: check
	type(field_data_t), pointer :: ptr
	end function model_data_get_field_ptr_pdg
	module function model_data_get_field_ptr_index (model, i) result (ptr)
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: i
	type(field_data_t), pointer :: ptr
	end function model_data_get_field_ptr_index
	<<Model data: procedures>>=
	module function model_data_get_field_ptr_name &
	(model, name, check) result (ptr)
	class(model_data_t), intent(in), target :: model
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: check
	type(field_data_t), pointer :: ptr
	integer :: i
	do i = 1, size (model%field)
	if (model%field(i)%matches_name (name, .false.)) then
	ptr => model%field(i)
	return
	else if (model%field(i)%matches_name (name, .true.)) then
	ptr => model%field(i)
	return
	end if
	end do
	ptr => null ()
	call model%field_error (check, name)
	end function model_data_get_field_ptr_name

	module function model_data_get_field_ptr_pdg (model, pdg, check) result (ptr)
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: pdg
	logical, intent(in), optional :: check
	type(field_data_t), pointer :: ptr
	integer :: i, pdg_abs
	if (pdg == 0) then
	ptr => null ()
	return
	end if
	pdg_abs = abs (pdg)
	do i = 1, size (model%field)
	if (abs(model%field(i)%get_pdg ()) == pdg_abs) then
	ptr => model%field(i)
	return
	end if
	end do
	ptr => null ()
	call model%field_error (check, pdg=pdg)
	end function model_data_get_field_ptr_pdg

	module function model_data_get_field_ptr_index (model, i) result (ptr)
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: i
	type(field_data_t), pointer :: ptr
	ptr => model%field(i)
	end function model_data_get_field_ptr_index

	@ %def model_data_get_field_ptr
	@ Do not assign a pointer, just check.
	<<Model data: model data: TBP>>=
	procedure :: test_field => model_data_test_field_pdg
	<<Model data: sub interfaces>>=
	module function model_data_test_field_pdg (model, pdg, check) result (exist)
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: pdg
	logical, intent(in), optional :: check
	logical :: exist
	end function model_data_test_field_pdg
	<<Model data: procedures>>=
	module function model_data_test_field_pdg (model, pdg, check) result (exist)
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: pdg
	logical, intent(in), optional :: check
	logical :: exist
	exist = associated (model%get_field_ptr (pdg, check))
	end function model_data_test_field_pdg

	@ %def model_data_test_field_pdg
	@ Error message, if [[check]] is set.
	<<Model data: model data: TBP>>=
	procedure :: field_error => model_data_field_error
	<<Model data: sub interfaces>>=
	module subroutine model_data_field_error (model, check, name, pdg)
	class(model_data_t), intent(in) :: model
	logical, intent(in), optional :: check
	type(string_t), intent(in), optional :: name
	integer, intent(in), optional :: pdg
	end subroutine model_data_field_error
	<<Model data: procedures>>=
	module subroutine model_data_field_error (model, check, name, pdg)
	class(model_data_t), intent(in) :: model
	logical, intent(in), optional :: check
	type(string_t), intent(in), optional :: name
	integer, intent(in), optional :: pdg
	if (present (check)) then
	if (check) then
	if (present (name)) then
	write (msg_buffer, "(A,1x,A,1x,A,1x,A)") &
	"No particle with name", char (name), &
	"is contained in model", char (model%name)
	else if (present (pdg)) then
	write (msg_buffer, "(A,1x,I0,1x,A,1x,A)") &
	"No particle with PDG code", pdg, &
	"is contained in model", char (model%name)
	else
	write (msg_buffer, "(A,1x,A,1x,A)") &
	"Particle missing", &
	"in model", char (model%name)
	end if
	call msg_fatal ()
	end if
	end if
	end subroutine model_data_field_error

	@ %def model_data_field_error
	@ Assign mass and width value, which are associated via pointer.
	Identify the particle via pdg.
	<<Model data: model data: TBP>>=
	procedure :: set_field_mass => model_data_set_field_mass_pdg
	procedure :: set_field_width => model_data_set_field_width_pdg
	<<Model data: sub interfaces>>=
	module subroutine model_data_set_field_mass_pdg (model, pdg, value)
	class(model_data_t), intent(inout) :: model
	integer, intent(in) :: pdg
	real(default), intent(in) :: value
	end subroutine model_data_set_field_mass_pdg
	module subroutine model_data_set_field_width_pdg (model, pdg, value)
	class(model_data_t), intent(inout) :: model
	integer, intent(in) :: pdg
	real(default), intent(in) :: value
	end subroutine model_data_set_field_width_pdg
	<<Model data: procedures>>=
	module subroutine model_data_set_field_mass_pdg (model, pdg, value)
	class(model_data_t), intent(inout) :: model
	integer, intent(in) :: pdg
	real(default), intent(in) :: value
	type(field_data_t), pointer :: field
	field => model%get_field_ptr (pdg, check = .true.)
	call field%set_mass (value)
	end subroutine model_data_set_field_mass_pdg

	module subroutine model_data_set_field_width_pdg (model, pdg, value)
	class(model_data_t), intent(inout) :: model
	integer, intent(in) :: pdg
	real(default), intent(in) :: value
	type(field_data_t), pointer :: field
	field => model%get_field_ptr (pdg, check = .true.)
	call field%set_width (value)
	end subroutine model_data_set_field_width_pdg

	@ %def model_data_set_field_mass
	@ %def model_data_set_field_width
	+
	+@ Label masses of particles only as input if they are not zero.
	+This is a requirement for input mass parameters of OLPs.
	+<<Model data: model data: TBP>>=
	+ procedure :: set_non_zero_masses_as_input => model_data_set_non_zero_masses_as_input
	+<<Model data: sub interfaces>>=
	+ module subroutine model_data_set_non_zero_masses_as_input (model)
	+ class(model_data_t), intent(in), target :: model
	+ type(field_data_t), dimension(:), pointer :: fields
	+ end subroutine model_data_set_non_zero_masses_as_input
	+<<Model data: procedures>>=
	+ module subroutine model_data_set_non_zero_masses_as_input (model)
	+ class(model_data_t), intent(in), target :: model
	+ type(field_data_t), dimension(:), pointer :: fields
	+ integer :: i
	+ fields => model%get_field_array_ptr ()
	+ do i = 1, size (fields)
	+ if (associated (fields(i)%mass_data)) then
	+ if (fields(i)%get_mass () > 0 &
	+ .and. fields(i)%mass_data%is_input_par ()) then
	+ call fields(i)%mass_data%set_input_par (.true.)
	+ else
	+ call fields(i)%mass_data%set_input_par (.false.)
	+ end if
	+ end if
	+ end do
	+ end subroutine model_data_set_non_zero_masses_as_input
	+
	+@ %def model_data_set_non_zero_masses_as_input
	@ Mark a particle as unstable and provide a list of names for its
	decay processes. In contrast with the previous subroutine which is
	for internal use, we address the particle by its PDG code. If the
	index is negative, we address the antiparticle.
	<<Model data: model data: TBP>>=
	procedure :: set_unstable => model_data_set_unstable
	procedure :: set_stable => model_data_set_stable
	<<Model data: sub interfaces>>=
	module subroutine model_data_set_unstable &
	(model, pdg, decay, isotropic, diagonal, decay_helicity)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: pdg
	type(string_t), dimension(:), intent(in) :: decay
	logical, intent(in), optional :: isotropic, diagonal
	integer, intent(in), optional :: decay_helicity
	end subroutine model_data_set_unstable
	module subroutine model_data_set_stable (model, pdg)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: pdg
	end subroutine model_data_set_stable
	<<Model data: procedures>>=
	module subroutine model_data_set_unstable &
	(model, pdg, decay, isotropic, diagonal, decay_helicity)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: pdg
	type(string_t), dimension(:), intent(in) :: decay
	logical, intent(in), optional :: isotropic, diagonal
	integer, intent(in), optional :: decay_helicity
	type(field_data_t), pointer :: field
	field => model%get_field_ptr (pdg)
	if (pdg > 0) then
	call field%set ( &
	p_is_stable = .false., p_decay = decay, &
	p_decays_isotropically = isotropic, &
	p_decays_diagonal = diagonal, &
	p_decay_helicity = decay_helicity)
	else
	call field%set ( &
	a_is_stable = .false., a_decay = decay, &
	a_decays_isotropically = isotropic, &
	a_decays_diagonal = diagonal, &
	a_decay_helicity = decay_helicity)
	end if
	end subroutine model_data_set_unstable

	module subroutine model_data_set_stable (model, pdg)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: pdg
	type(field_data_t), pointer :: field
	field => model%get_field_ptr (pdg)
	if (pdg > 0) then
	call field%set (p_is_stable = .true.)
	else
	call field%set (a_is_stable = .true.)
	end if
	end subroutine model_data_set_stable

	@ %def model_data_set_unstable
	@ %def model_data_set_stable
	@ Mark a particle as polarized.
	<<Model data: model data: TBP>>=
	procedure :: set_polarized => model_data_set_polarized
	procedure :: set_unpolarized => model_data_set_unpolarized
	<<Model data: sub interfaces>>=
	module subroutine model_data_set_polarized (model, pdg)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: pdg
	end subroutine model_data_set_polarized
	module subroutine model_data_set_unpolarized (model, pdg)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: pdg
	end subroutine model_data_set_unpolarized
	<<Model data: procedures>>=
	module subroutine model_data_set_polarized (model, pdg)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: pdg
	type(field_data_t), pointer :: field
	field => model%get_field_ptr (pdg)
	if (pdg > 0) then
	call field%set (p_polarized = .true.)
	else
	call field%set (a_polarized = .true.)
	end if
	end subroutine model_data_set_polarized

	module subroutine model_data_set_unpolarized (model, pdg)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: pdg
	type(field_data_t), pointer :: field
	field => model%get_field_ptr (pdg)
	if (pdg > 0) then
	call field%set (p_polarized = .false.)
	else
	call field%set (a_polarized = .false.)
	end if
	end subroutine model_data_set_unpolarized

	@ %def model_data_set_polarized
	@ %def model_data_set_unpolarized
	@ Revert all polarized (unstable) particles to unpolarized (stable)
	status, respectively.
	<<Model data: model data: TBP>>=
	procedure :: clear_unstable => model_clear_unstable
	procedure :: clear_polarized => model_clear_polarized
	<<Model data: sub interfaces>>=
	module subroutine model_clear_unstable (model)
	class(model_data_t), intent(inout), target :: model
	end subroutine model_clear_unstable
	module subroutine model_clear_polarized (model)
	class(model_data_t), intent(inout), target :: model
	end subroutine model_clear_polarized
	<<Model data: procedures>>=
	module subroutine model_clear_unstable (model)
	class(model_data_t), intent(inout), target :: model
	integer :: i
	type(field_data_t), pointer :: field
	do i = 1, model%get_n_field ()
	field => model%get_field_ptr_by_index (i)
	call field%set (p_is_stable = .true.)
	if (field%has_antiparticle ()) then
	call field%set (a_is_stable = .true.)
	end if
	end do
	end subroutine model_clear_unstable

	module subroutine model_clear_polarized (model)
	class(model_data_t), intent(inout), target :: model
	integer :: i
	type(field_data_t), pointer :: field
	do i = 1, model%get_n_field ()
	field => model%get_field_ptr_by_index (i)
	call field%set (p_polarized = .false.)
	if (field%has_antiparticle ()) then
	call field%set (a_polarized = .false.)
	end if
	end do
	end subroutine model_clear_polarized

	@ %def model_clear_unstable
	@ %def model_clear_polarized
	@ List all vertices, optionally also the hash table.
	<<Model data: model data: TBP>>=
	procedure :: write_vertices => model_data_write_vertices
	<<Model data: sub interfaces>>=
	module subroutine model_data_write_vertices (model, unit, verbose)
	class(model_data_t), intent(in) :: model
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine model_data_write_vertices
	<<Model data: procedures>>=
	module subroutine model_data_write_vertices (model, unit, verbose)
	class(model_data_t), intent(in) :: model
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: i, u
	u = given_output_unit (unit)
	do i = 1, size (model%vtx)
	call vertex_write (model%vtx(i), unit)
	end do
	if (present (verbose)) then
	if (verbose) then
	write (u, *)
	call vertex_table_write (model%vt, unit)
	end if
	end if
	end subroutine model_data_write_vertices

	@ %def model_data_write_vertices
	@ Vertex definition.
	<<Model data: model data: TBP>>=
	generic :: set_vertex => &
	model_data_set_vertex_pdg, model_data_set_vertex_names
	procedure, private :: model_data_set_vertex_pdg
	procedure, private :: model_data_set_vertex_names
	<<Model data: sub interfaces>>=
	module subroutine model_data_set_vertex_pdg (model, i, pdg)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: pdg
	end subroutine model_data_set_vertex_pdg
	module subroutine model_data_set_vertex_names (model, i, name)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), dimension(:), intent(in) :: name
	end subroutine model_data_set_vertex_names
	<<Model data: procedures>>=
	module subroutine model_data_set_vertex_pdg (model, i, pdg)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: pdg
	call vertex_init (model%vtx(i), pdg, model)
	end subroutine model_data_set_vertex_pdg

	module subroutine model_data_set_vertex_names (model, i, name)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), dimension(:), intent(in) :: name
	integer, dimension(size(name)) :: pdg
	integer :: j
	do j = 1, size (name)
	pdg(j) = model%get_pdg (name(j))
	end do
	call model%set_vertex (i, pdg)
	end subroutine model_data_set_vertex_names

	@ %def model_data_set_vertex
	@ Finalize vertex definition: set up the hash table.
	<<Model data: model data: TBP>>=
	procedure :: freeze_vertices => model_data_freeze_vertices
	<<Model data: sub interfaces>>=
	module subroutine model_data_freeze_vertices (model)
	class(model_data_t), intent(inout) :: model
	end subroutine model_data_freeze_vertices
	<<Model data: procedures>>=
	module subroutine model_data_freeze_vertices (model)
	class(model_data_t), intent(inout) :: model
	call model%vt%init (model%field, model%vtx)
	end subroutine model_data_freeze_vertices

	@ %def model_data_freeze_vertices
	@ Number of vertices in model
	<<Model data: model data: TBP>>=
	procedure :: get_n_vtx => model_data_get_n_vtx
	<<Model data: sub interfaces>>=
	module function model_data_get_n_vtx (model) result (n)
	class(model_data_t), intent(in) :: model
	integer :: n
	end function model_data_get_n_vtx
	<<Model data: procedures>>=
	module function model_data_get_n_vtx (model) result (n)
	class(model_data_t), intent(in) :: model
	integer :: n
	n = size (model%vtx)
	end function model_data_get_n_vtx

	@ %def model_data_get_n_vtx
	@ Lookup functions
	<<Model data: model data: TBP>>=
	procedure :: match_vertex => model_data_match_vertex
	<<Model data: sub interfaces>>=
	module subroutine model_data_match_vertex (model, pdg1, pdg2, pdg3)
	class(model_data_t), intent(in) :: model
	integer, intent(in) :: pdg1, pdg2
	integer, dimension(:), allocatable, intent(out) :: pdg3
	end subroutine model_data_match_vertex
	<<Model data: procedures>>=
	module subroutine model_data_match_vertex (model, pdg1, pdg2, pdg3)
	class(model_data_t), intent(in) :: model
	integer, intent(in) :: pdg1, pdg2
	integer, dimension(:), allocatable, intent(out) :: pdg3
	call model%vt%match (pdg1, pdg2, pdg3)
	end subroutine model_data_match_vertex

	@ %def model_data_match_vertex
	<<Model data: model data: TBP>>=
	procedure :: check_vertex => model_data_check_vertex
	<<Model data: sub interfaces>>=
	module function model_data_check_vertex &
	(model, pdg1, pdg2, pdg3) result (flag)
	logical :: flag
	class(model_data_t), intent(in) :: model
	integer, intent(in) :: pdg1, pdg2, pdg3
	end function model_data_check_vertex
	<<Model data: procedures>>=
	module function model_data_check_vertex &
	(model, pdg1, pdg2, pdg3) result (flag)
	logical :: flag
	class(model_data_t), intent(in) :: model
	integer, intent(in) :: pdg1, pdg2, pdg3
	flag = model%vt%check (pdg1, pdg2, pdg3)
	end function model_data_check_vertex

	@ %def model_data_check_vertex
	@
	\subsection{Toy Models}
	This is a stripped-down version of the (already trivial) model 'Test'.
	<<Model data: model data: TBP>>=
	procedure :: init_test => model_data_init_test
	<<Model data: sub interfaces>>=
	module subroutine model_data_init_test (model)
	class(model_data_t), intent(out) :: model
	end subroutine model_data_init_test
	<<Model data: procedures>>=
	module subroutine model_data_init_test (model)
	class(model_data_t), intent(out) :: model
	type(field_data_t), pointer :: field
	integer, parameter :: n_real = 4
	integer, parameter :: n_field = 2
	integer, parameter :: n_vertex = 2
	integer :: i
	call model%init (var_str ("Test"), &
	n_real, 0, n_field, n_vertex)
	i = 0
	i = i + 1
	call model%init_par (i, var_str ("gy"), 1._default)
	i = i + 1
	call model%init_par (i, var_str ("ms"), 125._default)
	i = i + 1
	call model%init_par (i, var_str ("ff"), 1.5_default)
	i = i + 1
	call model%init_par (i, var_str ("mf"), 1.5_default * 125._default)
	i = 0
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("SCALAR"), 25)
	call field%set (spin_type=1)
	call field%set (mass_data=model%get_par_real_ptr (2))
	call field%set (name = [var_str ("s")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("FERMION"), 6)
	call field%set (spin_type=2)
	call field%set (mass_data=model%get_par_real_ptr (4))
	call field%set (name = [var_str ("f")], anti = [var_str ("fbar")])
	call model%freeze_fields ()
	i = 0
	i = i + 1
	call model%set_vertex (i, [var_str ("fbar"), var_str ("f"), var_str ("s")])
	i = i + 1
	call model%set_vertex (i, [var_str ("s"), var_str ("s"), var_str ("s")])
	call model%freeze_vertices ()
	end subroutine model_data_init_test

	@ %def model_data_init_test
	@
	This procedure prepares a subset of QED for testing purposes.
	<<Model data: model data: TBP>>=
	procedure :: init_qed_test => model_data_init_qed_test
	<<Model data: sub interfaces>>=
	module subroutine model_data_init_qed_test (model)
	class(model_data_t), intent(out) :: model
	end subroutine model_data_init_qed_test
	<<Model data: procedures>>=
	module subroutine model_data_init_qed_test (model)
	class(model_data_t), intent(out) :: model
	type(field_data_t), pointer :: field
	integer, parameter :: n_real = 1
	integer, parameter :: n_field = 2
	integer :: i
	call model%init (var_str ("QED_test"), &
	n_real, 0, n_field, 0)
	i = 0
	i = i + 1
	call model%init_par (i, var_str ("me"), 0.000510997_default)
	i = 0
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("E_LEPTON"), 11)
	call field%set (spin_type=2, charge_type=-4)
	call field%set (mass_data=model%get_par_real_ptr (1))
	call field%set (name = [var_str ("e-")], anti = [var_str ("e+")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("PHOTON"), 22)
	call field%set (spin_type=3)
	call field%set (name = [var_str ("A")])
	call model%freeze_fields ()
	call model%freeze_vertices ()
	end subroutine model_data_init_qed_test

	@ %def model_data_init_qed_test
	@
	This procedure prepares a subset of the Standard Model for testing purposes.
	We can thus avoid dependencies on model I/O, which is not defined here.
	<<Model data: model data: TBP>>=
	procedure :: init_sm_test => model_data_init_sm_test
	<<Model data: sub interfaces>>=
	module subroutine model_data_init_sm_test (model)
	class(model_data_t), intent(out) :: model
	end subroutine model_data_init_sm_test
	<<Model data: procedures>>=
	module subroutine model_data_init_sm_test (model)
	class(model_data_t), intent(out) :: model
	type(field_data_t), pointer :: field
	integer, parameter :: n_real = 11
	integer, parameter :: n_field = 19
	integer, parameter :: n_vtx = 9
	integer :: i
	call model%init (var_str ("SM_test"), &
	n_real, 0, n_field, n_vtx)
	i = 0
	i = i + 1
	call model%init_par (i, var_str ("mZ"), 91.1882_default)
	i = i + 1
	call model%init_par (i, var_str ("mW"), 80.419_default)
	i = i + 1
	call model%init_par (i, var_str ("me"), 0.000510997_default)
	i = i + 1
	call model%init_par (i, var_str ("mmu"), 0.105658389_default)
	i = i + 1
	call model%init_par (i, var_str ("mb"), 4.2_default)
	i = i + 1
	call model%init_par (i, var_str ("mtop"), 173.1_default)
	i = i + 1
	call model%init_par (i, var_str ("wZ"), 2.443_default)
	i = i + 1
	call model%init_par (i, var_str ("wW"), 2.049_default)
	i = i + 1
	call model%init_par (i, var_str ("ee"), 0.3079561542961_default)
	i = i + 1
	call model%init_par (i, var_str ("cw"), 8.819013863636E-01_default)
	i = i + 1
	call model%init_par (i, var_str ("sw"), 4.714339240339E-01_default)
	i = 0
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("D_QUARK"), 1)
	call field%set (spin_type=2, color_type=3, charge_type=-2, isospin_type=-2)
	call field%set (name = [var_str ("d")], anti = [var_str ("dbar")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("U_QUARK"), 2)
	call field%set (spin_type=2, color_type=3, charge_type=3, isospin_type=2)
	call field%set (name = [var_str ("u")], anti = [var_str ("ubar")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("S_QUARK"), 3)
	call field%set (spin_type=2, color_type=3, charge_type=-2, isospin_type=-2)
	call field%set (name = [var_str ("s")], anti = [var_str ("sbar")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("C_QUARK"), 4)
	call field%set (spin_type=2, color_type=3, charge_type=3, isospin_type=2)
	call field%set (name = [var_str ("c")], anti = [var_str ("cbar")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("B_QUARK"), 5)
	call field%set (spin_type=2, color_type=3, charge_type=-2, isospin_type=-2)
	call field%set (mass_data=model%get_par_real_ptr (5))
	call field%set (name = [var_str ("b")], anti = [var_str ("bbar")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("T_QUARK"), 6)
	call field%set (spin_type=2, color_type=3, charge_type=3, isospin_type=2)
	call field%set (mass_data=model%get_par_real_ptr (6))
	call field%set (name = [var_str ("t")], anti = [var_str ("tbar")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("E_LEPTON"), 11)
	call field%set (spin_type=2)
	call field%set (mass_data=model%get_par_real_ptr (3))
	call field%set (name = [var_str ("e-")], anti = [var_str ("e+")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("E_NEUTRINO"), 12)
	call field%set (spin_type=2, is_left_handed=.true.)
	call field%set (name = [var_str ("nue")], anti = [var_str ("nuebar")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("MU_LEPTON"), 13)
	call field%set (spin_type=2)
	call field%set (mass_data=model%get_par_real_ptr (4))
	call field%set (name = [var_str ("mu-")], anti = [var_str ("mu+")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("MU_NEUTRINO"), 14)
	call field%set (spin_type=2, is_left_handed=.true.)
	call field%set (name = [var_str ("numu")], anti = [var_str ("numubar")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("GLUON"), 21)
	call field%set (spin_type=3, color_type=8)
	call field%set (name = [var_str ("gl")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("PHOTON"), 22)
	call field%set (spin_type=3)
	call field%set (name = [var_str ("A")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("Z_BOSON"), 23)
	call field%set (spin_type=3)
	call field%set (mass_data=model%get_par_real_ptr (1))
	call field%set (width_data=model%get_par_real_ptr (7))
	call field%set (name = [var_str ("Z")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("W_BOSON"), 24)
	call field%set (spin_type=3)
	call field%set (mass_data=model%get_par_real_ptr (2))
	call field%set (width_data=model%get_par_real_ptr (8))
	call field%set (name = [var_str ("W+")], anti = [var_str ("W-")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("HIGGS"), 25)
	call field%set (spin_type=1)
	! call field%set (mass_data=model%get_par_real_ptr (2))
	! call field%set (width_data=model%get_par_real_ptr (8))
	call field%set (name = [var_str ("H")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("PROTON"), 2212)
	call field%set (spin_type=2)
	call field%set (name = [var_str ("p")], anti = [var_str ("pbar")])
	! call field%set (mass_data=model%get_par_real_ptr (12))
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("HADRON_REMNANT_SINGLET"), 91)
	call field%set (color_type=1)
	call field%set (name = [var_str ("hr1")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("HADRON_REMNANT_TRIPLET"), 92)
	call field%set (color_type=3)
	call field%set (name = [var_str ("hr3")], anti = [var_str ("hr3bar")])
	i = i + 1
	field => model%get_field_ptr_by_index (i)
	call field%init (var_str ("HADRON_REMNANT_OCTET"), 93)
	call field%set (color_type=8)
	call field%set (name = [var_str ("hr8")])
	call model%freeze_fields ()
	i = 0
	i = i + 1
	call model%set_vertex (i, [var_str ("dbar"), var_str ("d"), var_str ("A")])
	i = i + 1
	call model%set_vertex (i, [var_str ("ubar"), var_str ("u"), var_str ("A")])
	i = i + 1
	call model%set_vertex (i, [var_str ("gl"), var_str ("gl"), var_str ("gl")])
	i = i + 1
	call model%set_vertex (i, [var_str ("dbar"), var_str ("d"), var_str ("gl")])
	i = i + 1
	call model%set_vertex (i, [var_str ("ubar"), var_str ("u"), var_str ("gl")])
	i = i + 1
	call model%set_vertex (i, [var_str ("dbar"), var_str ("d"), var_str ("Z")])
	i = i + 1
	call model%set_vertex (i, [var_str ("ubar"), var_str ("u"), var_str ("Z")])
	i = i + 1
	call model%set_vertex (i, [var_str ("ubar"), var_str ("d"), var_str ("W+")])
	i = i + 1
	call model%set_vertex (i, [var_str ("dbar"), var_str ("u"), var_str ("W-")])
	call model%freeze_vertices ()
	end subroutine model_data_init_sm_test

	@ %def model_data_init_sm_test
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Model Testbed}
	The standard way of defining a model uses concrete variables and expressions to
	interpret the model file. Some of this is not available at the point of use. This
	is no problem for the \whizard\ program as a whole, but unit tests are
	kept local to their respective module and don't access all definitions.

	Instead, we introduce a separate module that provides hooks, one for
	initializing a model and one for finalizing a model. The main program can
	assign real routines to the hooks (procedure pointers of abstract type) before
	unit tests are called. The unit tests can call the abstract routines without
	knowing about their implementation.
	<<[[model_testbed.f90]]>>=
	<<File header>>

	module model_testbed

	<<Use strings>>
	use model_data
	use var_base

	<<Standard module head>>

	<<Model testbed: public>>

	<<Model testbed: variables>>

	<<Model testbed: interfaces>>

	end module model_testbed
	@ %def model_testbed
	@
	\subsection{Abstract Model Handlers}
	Both routines take a polymorphic model (data) target, which
	is not allocated/deallocated inside the subroutine. The model constructor
	[[prepare_model]] requires the model name as input. It can, optionally,
	return a link to the variable list of the model.
	<<Model testbed: public>>=
	public :: prepare_model
	public :: cleanup_model
	<<Model testbed: variables>>=
	procedure (prepare_model_proc), pointer :: prepare_model => null ()
	procedure (cleanup_model_proc), pointer :: cleanup_model => null ()
	<<Model testbed: interfaces>>=
	abstract interface
	subroutine prepare_model_proc (model, name, vars)
	import
	class(model_data_t), intent(inout), pointer :: model
	type(string_t), intent(in) :: name
	class(vars_t), pointer, intent(out), optional :: vars
	end subroutine prepare_model_proc
	end interface

	abstract interface
	subroutine cleanup_model_proc (model)
	import
	class(model_data_t), intent(inout), target :: model
	end subroutine cleanup_model_proc
	end interface

	@ %def prepare_model
	@ %def cleanup_model
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Helicities}
	This module defines types and tools for dealing with helicity
	information.
	<<[[helicities.f90]]>>=
	<<File header>>

	module helicities

	<<Standard module head>>

	<<Helicities: public>>

	<<Helicities: types>>

	<<Helicities: interfaces>>

	interface
	<<Helicities: sub interfaces>>
	end interface

	end module helicities
	@ %def helicities
	@
	<<[[helicities_sub.f90]]>>=
	<<File header>>

	submodule (helicities) helicities_s

	use io_units

	implicit none

	contains

	<<Helicities: procedures>>

	end submodule helicities_s

	@ %def helicities_s
	@
	\subsection{Helicity types}
	Helicities may be defined or undefined, corresponding to a polarized
	or unpolarized state. Each helicity is actually a pair of helicities,
	corresponding to an entry in the spin density matrix. Obviously,
	diagonal entries are distinguished.
	<<Helicities: public>>=
	public :: helicity_t
	<<Helicities: types>>=
	type :: helicity_t
	private
	logical :: defined = .false.
	integer :: h1, h2
	contains
	<<Helicities: helicity: TBP>>
	end type helicity_t

	@ %def helicity_t
	@ Constructor functions, for convenience:
	<<Helicities: public>>=
	public :: helicity
	<<Helicities: interfaces>>=
	interface helicity
	module procedure helicity0, helicity1, helicity2
	end interface helicity

	<<Helicities: sub interfaces>>=
	pure module function helicity0 () result (hel)
	type(helicity_t) :: hel
	end function helicity0
	elemental module function helicity1 (h) result (hel)
	type(helicity_t) :: hel
	integer, intent(in) :: h
	end function helicity1
	elemental module function helicity2 (h2, h1) result (hel)
	type(helicity_t) :: hel
	integer, intent(in) :: h1, h2
	end function helicity2
	<<Helicities: procedures>>=
	pure module function helicity0 () result (hel)
	type(helicity_t) :: hel
	end function helicity0

	elemental module function helicity1 (h) result (hel)
	type(helicity_t) :: hel
	integer, intent(in) :: h
	call hel%init (h)
	end function helicity1

	elemental module function helicity2 (h2, h1) result (hel)
	type(helicity_t) :: hel
	integer, intent(in) :: h1, h2
	call hel%init (h2, h1)
	end function helicity2

	@ %def helicity
	@ Initializers.

	Note: conceptually, the argument to initializers should be INTENT(OUT).
	However, Interp.\ F08/0033 prohibited this. The reason is that, in principle,
	the call could result in the execution of an impure finalizer for a type
	extension of [[hel]] (ugh).
	<<Helicities: helicity: TBP>>=
	generic :: init => helicity_init_empty, helicity_init_same, helicity_init_different
	procedure, private :: helicity_init_empty
	procedure, private :: helicity_init_same
	procedure, private :: helicity_init_different
	<<Helicities: sub interfaces>>=
	elemental module subroutine helicity_init_empty (hel)
	class(helicity_t), intent(inout) :: hel
	end subroutine helicity_init_empty
	elemental module subroutine helicity_init_same (hel, h)
	class(helicity_t), intent(inout) :: hel
	integer, intent(in) :: h
	end subroutine helicity_init_same
	elemental module subroutine helicity_init_different (hel, h2, h1)
	class(helicity_t), intent(inout) :: hel
	integer, intent(in) :: h1, h2
	end subroutine helicity_init_different
	<<Helicities: procedures>>=
	elemental module subroutine helicity_init_empty (hel)
	class(helicity_t), intent(inout) :: hel
	hel%defined = .false.
	end subroutine helicity_init_empty

	elemental module subroutine helicity_init_same (hel, h)
	class(helicity_t), intent(inout) :: hel
	integer, intent(in) :: h
	hel%defined = .true.
	hel%h1 = h
	hel%h2 = h
	end subroutine helicity_init_same

	elemental module subroutine helicity_init_different (hel, h2, h1)
	class(helicity_t), intent(inout) :: hel
	integer, intent(in) :: h1, h2
	hel%defined = .true.
	hel%h2 = h2
	hel%h1 = h1
	end subroutine helicity_init_different

	@ %def helicity_init
	@ Undefine:
	<<Helicities: helicity: TBP>>=
	procedure :: undefine => helicity_undefine
	<<Helicities: sub interfaces>>=
	elemental module subroutine helicity_undefine (hel)
	class(helicity_t), intent(inout) :: hel
	end subroutine helicity_undefine
	<<Helicities: procedures>>=
	elemental module subroutine helicity_undefine (hel)
	class(helicity_t), intent(inout) :: hel
	hel%defined = .false.
	end subroutine helicity_undefine

	@ %def helicity_undefine
	@ Diagonalize by removing the second entry (use with care!)
	<<Helicities: helicity: TBP>>=
	procedure :: diagonalize => helicity_diagonalize
	<<Helicities: sub interfaces>>=
	elemental module subroutine helicity_diagonalize (hel)
	class(helicity_t), intent(inout) :: hel
	end subroutine helicity_diagonalize
	<<Helicities: procedures>>=
	elemental module subroutine helicity_diagonalize (hel)
	class(helicity_t), intent(inout) :: hel
	hel%h2 = hel%h1
	end subroutine helicity_diagonalize

	@ %def helicity_diagonalize
	@ Flip helicity indices by sign.
	<<Helicities: helicity: TBP>>=
	procedure :: flip => helicity_flip
	<<Helicities: sub interfaces>>=
	elemental module subroutine helicity_flip (hel)
	class(helicity_t), intent(inout) :: hel
	end subroutine helicity_flip
	<<Helicities: procedures>>=
	elemental module subroutine helicity_flip (hel)
	class(helicity_t), intent(inout) :: hel
	hel%h1 = - hel%h1
	hel%h2 = - hel%h2
	end subroutine helicity_flip

	@ %def helicity_flip
	@
	<<Helicities: helicity: TBP>>=
	procedure :: get_indices => helicity_get_indices
	<<Helicities: sub interfaces>>=
	module subroutine helicity_get_indices (hel, h1, h2)
	class(helicity_t), intent(in) :: hel
	integer, intent(out) :: h1, h2
	end subroutine helicity_get_indices
	<<Helicities: procedures>>=
	module subroutine helicity_get_indices (hel, h1, h2)
	class(helicity_t), intent(in) :: hel
	integer, intent(out) :: h1, h2
	h1 = hel%h1; h2 = hel%h2
	end subroutine helicity_get_indices

	@ %def helicity_get_indices
	@ Output (no linebreak). No output if undefined.
	<<Helicities: helicity: TBP>>=
	procedure :: write => helicity_write
	<<Helicities: sub interfaces>>=
	module subroutine helicity_write (hel, unit)
	class(helicity_t), intent(in) :: hel
	integer, intent(in), optional :: unit
	end subroutine helicity_write
	<<Helicities: procedures>>=
	module subroutine helicity_write (hel, unit)
	class(helicity_t), intent(in) :: hel
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	if (hel%defined) then
	write (u, "(A)", advance="no") "h("
	write (u, "(I0)", advance="no") hel%h1
	if (hel%h1 /= hel%h2) then
	write (u, "(A)", advance="no") "\|"
	write (u, "(I0)", advance="no") hel%h2
	end if
	write (u, "(A)", advance="no") ")"
	end if
	end subroutine helicity_write

	@ %def helicity_write
	@ Binary I/O. Write contents only if defined.
	<<Helicities: helicity: TBP>>=
	procedure :: write_raw => helicity_write_raw
	procedure :: read_raw => helicity_read_raw
	<<Helicities: sub interfaces>>=
	module subroutine helicity_write_raw (hel, u)
	class(helicity_t), intent(in) :: hel
	integer, intent(in) :: u
	end subroutine helicity_write_raw
	module subroutine helicity_read_raw (hel, u, iostat)
	class(helicity_t), intent(out) :: hel
	integer, intent(in) :: u
	integer, intent(out), optional :: iostat
	end subroutine helicity_read_raw
	<<Helicities: procedures>>=
	module subroutine helicity_write_raw (hel, u)
	class(helicity_t), intent(in) :: hel
	integer, intent(in) :: u
	write (u) hel%defined
	if (hel%defined) then
	write (u) hel%h1, hel%h2
	end if
	end subroutine helicity_write_raw

	module subroutine helicity_read_raw (hel, u, iostat)
	class(helicity_t), intent(out) :: hel
	integer, intent(in) :: u
	integer, intent(out), optional :: iostat
	read (u, iostat=iostat) hel%defined
	if (hel%defined) then
	read (u, iostat=iostat) hel%h1, hel%h2
	end if
	end subroutine helicity_read_raw

	@ %def helicity_write_raw helicity_read_raw
	@
	\subsection{Predicates}
	Check if the helicity is defined:
	<<Helicities: helicity: TBP>>=
	procedure :: is_defined => helicity_is_defined
	<<Helicities: sub interfaces>>=
	elemental module function helicity_is_defined (hel) result (defined)
	logical :: defined
	class(helicity_t), intent(in) :: hel
	end function helicity_is_defined
	<<Helicities: procedures>>=
	elemental module function helicity_is_defined (hel) result (defined)
	logical :: defined
	class(helicity_t), intent(in) :: hel
	defined = hel%defined
	end function helicity_is_defined

	@ %def helicity_is_defined
	@ Return true if the two helicities are equal or the particle is unpolarized:
	<<Helicities: helicity: TBP>>=
	procedure :: is_diagonal => helicity_is_diagonal
	<<Helicities: sub interfaces>>=
	elemental module function helicity_is_diagonal (hel) result (diagonal)
	logical :: diagonal
	class(helicity_t), intent(in) :: hel
	end function helicity_is_diagonal
	<<Helicities: procedures>>=
	elemental module function helicity_is_diagonal (hel) result (diagonal)
	logical :: diagonal
	class(helicity_t), intent(in) :: hel
	if (hel%defined) then
	diagonal = hel%h1 == hel%h2
	else
	diagonal = .true.
	end if
	end function helicity_is_diagonal

	@ %def helicity_is_diagonal
	@
	\subsection{Accessing contents}
	This returns a two-element array and thus cannot be elemental. The
	result is unpredictable if the helicity is undefined.
	<<Helicities: helicity: TBP>>=
	procedure :: to_pair => helicity_to_pair
	<<Helicities: sub interfaces>>=
	pure module function helicity_to_pair (hel) result (h)
	integer, dimension(2) :: h
	class(helicity_t), intent(in) :: hel
	end function helicity_to_pair
	<<Helicities: procedures>>=
	pure module function helicity_to_pair (hel) result (h)
	integer, dimension(2) :: h
	class(helicity_t), intent(in) :: hel
	h(1) = hel%h2
	h(2) = hel%h1
	end function helicity_to_pair

	@ %def helicity_to_pair
	@
	\subsection{Comparisons}
	When comparing helicities, if either one is undefined, they are
	considered to match. In other words, an unpolarized particle matches
	any polarization. In the [[dmatch]] variant, it matches only diagonal
	helicity.
	<<Helicities: helicity: TBP>>=
	generic :: operator(.match.) => helicity_match
	generic :: operator(.dmatch.) => helicity_match_diagonal
	generic :: operator(==) => helicity_eq
	generic :: operator(/=) => helicity_neq
	procedure, private :: helicity_match
	procedure, private :: helicity_match_diagonal
	procedure, private :: helicity_eq
	procedure, private :: helicity_neq
	@ %def .match. .dmatch. == /=
	<<Helicities: sub interfaces>>=
	elemental module function helicity_match (hel1, hel2) result (eq)
	logical :: eq
	class(helicity_t), intent(in) :: hel1, hel2
	end function helicity_match
	elemental module function helicity_match_diagonal (hel1, hel2) result (eq)
	logical :: eq
	class(helicity_t), intent(in) :: hel1, hel2
	end function helicity_match_diagonal
	<<Helicities: procedures>>=
	elemental module function helicity_match (hel1, hel2) result (eq)
	logical :: eq
	class(helicity_t), intent(in) :: hel1, hel2
	if (hel1%defined .and. hel2%defined) then
	eq = (hel1%h1 == hel2%h1) .and. (hel1%h2 == hel2%h2)
	else
	eq = .true.
	end if
	end function helicity_match

	elemental module function helicity_match_diagonal (hel1, hel2) result (eq)
	logical :: eq
	class(helicity_t), intent(in) :: hel1, hel2
	if (hel1%defined .and. hel2%defined) then
	eq = (hel1%h1 == hel2%h1) .and. (hel1%h2 == hel2%h2)
	else if (hel1%defined) then
	eq = hel1%h1 == hel1%h2
	else if (hel2%defined) then
	eq = hel2%h1 == hel2%h2
	else
	eq = .true.
	end if
	end function helicity_match_diagonal

	@ %def helicity_match helicity_match_diagonal
	<<Helicities: sub interfaces>>=
	elemental module function helicity_eq (hel1, hel2) result (eq)
	logical :: eq
	class(helicity_t), intent(in) :: hel1, hel2
	end function helicity_eq
	<<Helicities: procedures>>=
	elemental module function helicity_eq (hel1, hel2) result (eq)
	logical :: eq
	class(helicity_t), intent(in) :: hel1, hel2
	if (hel1%defined .and. hel2%defined) then
	eq = (hel1%h1 == hel2%h1) .and. (hel1%h2 == hel2%h2)
	else if (.not. hel1%defined .and. .not. hel2%defined) then
	eq = .true.
	else
	eq = .false.
	end if
	end function helicity_eq

	@ %def helicity_eq
	<<Helicities: sub interfaces>>=
	elemental module function helicity_neq (hel1, hel2) result (neq)
	logical :: neq
	class(helicity_t), intent(in) :: hel1, hel2
	end function helicity_neq
	<<Helicities: procedures>>=
	elemental module function helicity_neq (hel1, hel2) result (neq)
	logical :: neq
	class(helicity_t), intent(in) :: hel1, hel2
	if (hel1%defined .and. hel2%defined) then
	neq = (hel1%h1 /= hel2%h1) .or. (hel1%h2 /= hel2%h2)
	else if (.not. hel1%defined .and. .not. hel2%defined) then
	neq = .false.
	else
	neq = .true.
	end if
	end function helicity_neq

	@ %def helicity_neq
	@
	\subsection{Tools}
	Merge two helicity objects by taking the first entry from the first and
	the second entry from the second argument. Makes sense only if the
	input helicities were defined and diagonal. The handling of ghost
	flags is not well-defined; one should verify beforehand that they
	match.
	<<Helicities: helicity: TBP>>=
	generic :: operator(.merge.) => merge_helicities
	procedure, private :: merge_helicities
	@ %def .merge.
	<<Helicities: sub interfaces>>=
	elemental module function merge_helicities (hel1, hel2) result (hel)
	type(helicity_t) :: hel
	class(helicity_t), intent(in) :: hel1, hel2
	end function merge_helicities
	<<Helicities: procedures>>=
	elemental module function merge_helicities (hel1, hel2) result (hel)
	type(helicity_t) :: hel
	class(helicity_t), intent(in) :: hel1, hel2
	if (hel1%defined .and. hel2%defined) then
	call hel%init (hel2%h1, hel1%h1)
	else if (hel1%defined) then
	call hel%init (hel1%h2, hel1%h1)
	else if (hel2%defined) then
	call hel%init (hel2%h2, hel2%h1)
	end if
	end function merge_helicities

	@ %def merge_helicities
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Colors}
	This module defines a type and tools for dealing with color information.

	Each particle can have zero or more (in practice, usually not more
	than two) color indices. Color indices are positive; flow direction
	can be determined from the particle nature.

	While parton shower matrix elements are diagonal in color, some
	special applications (e.g., subtractions for NLO matrix elements)
	require non-diagonal color matrices.
	<<[[colors.f90]]>>=
	<<File header>>

	module colors

	<<Use kinds>>
	<<Use strings>>

	<<Standard module head>>

	<<Colors: public>>

	<<Colors: types>>

	<<Colors: interfaces>>

	interface
	<<Colors: sub interfaces>>
	end interface

	end module colors
	@ %def colors
	@
	<<[[colors_sub.f90]]>>=
	<<File header>>

	submodule (colors) colors_s

	use io_units
	use diagnostics

	implicit none

	contains

	<<Colors: procedures>>

	end submodule colors_s

	@ %def colors_s
	@
	\subsection{The color type}
	A particle may have an arbitrary number of color indices (in practice,
	from zero to two, but more are possible). This object acts as a
	container. (The current implementation has a fixed array of length two.)

	The fact that color comes as an array prohibits elemental procedures
	in some places. (May add interfaces and multi versions where
	necessary.)

	The color may be undefined.

	NOTE: Due to a compiler bug in nagfor 5.2, we do not use allocatable
	but fixed-size arrays with dimension 2. Only nonzero entries count.
	This may be more efficient anyway, but gives up some flexibility.
	However, the squaring algorithm currently works only for singlets,
	(anti)triplets and octets anyway, so two components are enough.

	This type has to be generalized (abstract type and specific
	implementations) when trying to pursue generalized color flows or
	Monte Carlo over continuous color.
	<<Colors: public>>=
	public :: color_t
	<<Colors: types>>=
	type :: color_t
	private
	logical :: defined = .false.
	integer, dimension(2) :: c1 = 0, c2 = 0
	logical :: ghost = .false.
	contains
	<<Colors: color: TBP>>
	end type color_t

	@ %def color_t
	<<Colors: types>>=
	type :: entry_t
	integer, dimension(:), allocatable :: map
	type(color_t), dimension(:), allocatable :: col
	type(entry_t), pointer :: next => null ()
	logical :: nlo_event = .false.
	end type entry_t
	type :: list_t
	integer :: n = 0
	type(entry_t), pointer :: first => null ()
	type(entry_t), pointer :: last => null ()
	end type list_t

	@ %def entry_t list_t
	@ Initializers:
	<<Colors: color: TBP>>=
	generic :: init => &
	color_init_trivial, color_init_trivial_ghost, &
	color_init_array, color_init_array_ghost, &
	color_init_arrays, color_init_arrays_ghost
	procedure, private :: color_init_trivial
	procedure, private :: color_init_trivial_ghost
	procedure, private :: color_init_array
	procedure, private :: color_init_array_ghost
	procedure, private :: color_init_arrays
	procedure, private :: color_init_arrays_ghost
	@ Undefined color: array remains unallocated
	<<Colors: sub interfaces>>=
	pure module subroutine color_init_trivial (col)
	class(color_t), intent(inout) :: col
	end subroutine color_init_trivial
	pure module subroutine color_init_trivial_ghost (col, ghost)
	class(color_t), intent(inout) :: col
	logical, intent(in) :: ghost
	end subroutine color_init_trivial_ghost
	<<Colors: procedures>>=
	pure module subroutine color_init_trivial (col)
	class(color_t), intent(inout) :: col
	col%defined = .true.
	col%c1 = 0
	col%c2 = 0
	col%ghost = .false.
	end subroutine color_init_trivial

	pure module subroutine color_init_trivial_ghost (col, ghost)
	class(color_t), intent(inout) :: col
	logical, intent(in) :: ghost
	col%defined = .true.
	col%c1 = 0
	col%c2 = 0
	col%ghost = ghost
	end subroutine color_init_trivial_ghost

	@ This defines color from an arbitrary length color array, suitable
	for any representation. We may have two color arrays (non-diagonal
	matrix elements). This cannot be elemental. The third version
	assigns an array of colors, using a two-dimensional array as input.
	<<Colors: sub interfaces>>=
	pure module subroutine color_init_array (col, c1)
	class(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1
	end subroutine color_init_array
	pure module subroutine color_init_array_ghost (col, c1, ghost)
	class(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1
	logical, intent(in) :: ghost
	end subroutine color_init_array_ghost
	pure module subroutine color_init_arrays (col, c1, c2)
	class(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1, c2
	end subroutine color_init_arrays
	pure module subroutine color_init_arrays_ghost (col, c1, c2, ghost)
	class(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1, c2
	logical, intent(in) :: ghost
	end subroutine color_init_arrays_ghost
	<<Colors: procedures>>=
	pure module subroutine color_init_array (col, c1)
	class(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1
	col%defined = .true.
	col%c1 = pack (c1, c1 /= 0, [0,0])
	col%c2 = col%c1
	col%ghost = .false.
	end subroutine color_init_array

	pure module subroutine color_init_array_ghost (col, c1, ghost)
	class(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1
	logical, intent(in) :: ghost
	call color_init_array (col, c1)
	col%ghost = ghost
	end subroutine color_init_array_ghost

	pure module subroutine color_init_arrays (col, c1, c2)
	class(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1, c2
	col%defined = .true.
	if (size (c1) == size (c2)) then
	col%c1 = pack (c1, c1 /= 0, [0,0])
	col%c2 = pack (c2, c2 /= 0, [0,0])
	else if (size (c1) /= 0) then
	col%c1 = pack (c1, c1 /= 0, [0,0])
	col%c2 = col%c1
	else if (size (c2) /= 0) then
	col%c1 = pack (c2, c2 /= 0, [0,0])
	col%c2 = col%c1
	end if
	col%ghost = .false.
	end subroutine color_init_arrays

	pure module subroutine color_init_arrays_ghost (col, c1, c2, ghost)
	class(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1, c2
	logical, intent(in) :: ghost
	call color_init_arrays (col, c1, c2)
	col%ghost = ghost
	end subroutine color_init_arrays_ghost

	@ %def color_init
	@ This version is restricted to singlets, triplets, antitriplets, and
	octets: The input contains the color and anticolor index, each of the
	may be zero.
	<<Colors: color: TBP>>=
	procedure :: init_col_acl => color_init_col_acl
	<<Colors: sub interfaces>>=
	elemental module subroutine color_init_col_acl (col, col_in, acl_in)
	class(color_t), intent(inout) :: col
	integer, intent(in) :: col_in, acl_in
	end subroutine color_init_col_acl
	<<Colors: procedures>>=
	elemental module subroutine color_init_col_acl (col, col_in, acl_in)
	class(color_t), intent(inout) :: col
	integer, intent(in) :: col_in, acl_in
	integer, dimension(0) :: null_array
	select case (col_in)
	case (0)
	select case (acl_in)
	case (0)
	call color_init_array (col, null_array)
	case default
	call color_init_array (col, [-acl_in])
	end select
	case default
	select case (acl_in)
	case (0)
	call color_init_array (col, [col_in])
	case default
	call color_init_array (col, [col_in, -acl_in])
	end select
	end select
	end subroutine color_init_col_acl

	@ %def color_init_col_acl
	@ This version is used for the external interface. We convert a
	fixed-size array of colors (for each particle) to the internal form by
	packing only the nonzero entries.

	Some of these procedures produce an arry, so they can't be all
	type-bound. We implement them as ordinary procedures.
	<<Colors: public>>=
	public :: color_init_from_array
	<<Colors: interfaces>>=
	interface color_init_from_array
	module procedure color_init_from_array1
	module procedure color_init_from_array1g
	module procedure color_init_from_array2
	module procedure color_init_from_array2g
	end interface color_init_from_array

	@ %def color_init_from_array
	<<Colors: sub interfaces>>=
	pure module subroutine color_init_from_array1 (col, c1)
	type(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1
	end subroutine color_init_from_array1
	pure module subroutine color_init_from_array1g (col, c1, ghost)
	type(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1
	logical, intent(in) :: ghost
	end subroutine color_init_from_array1g
	pure module subroutine color_init_from_array2 (col, c1)
	integer, dimension(:,:), intent(in) :: c1
	type(color_t), dimension(:), intent(inout) :: col
	end subroutine color_init_from_array2
	pure module subroutine color_init_from_array2g (col, c1, ghost)
	integer, dimension(:,:), intent(in) :: c1
	type(color_t), dimension(:), intent(out) :: col
	logical, intent(in), dimension(:) :: ghost
	end subroutine color_init_from_array2g
	<<Colors: procedures>>=
	pure module subroutine color_init_from_array1 (col, c1)
	type(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1
	logical, dimension(size(c1)) :: mask
	mask = c1 /= 0
	col%defined = .true.
	col%c1 = pack (c1, mask, col%c1)
	col%c2 = col%c1
	col%ghost = .false.
	end subroutine color_init_from_array1

	pure module subroutine color_init_from_array1g (col, c1, ghost)
	type(color_t), intent(inout) :: col
	integer, dimension(:), intent(in) :: c1
	logical, intent(in) :: ghost
	call color_init_from_array1 (col, c1)
	col%ghost = ghost
	end subroutine color_init_from_array1g

	pure module subroutine color_init_from_array2 (col, c1)
	integer, dimension(:,:), intent(in) :: c1
	type(color_t), dimension(:), intent(inout) :: col
	integer :: i
	do i = 1, size (c1,2)
	call color_init_from_array1 (col(i), c1(:,i))
	end do
	end subroutine color_init_from_array2

	pure module subroutine color_init_from_array2g (col, c1, ghost)
	integer, dimension(:,:), intent(in) :: c1
	type(color_t), dimension(:), intent(out) :: col
	logical, intent(in), dimension(:) :: ghost
	call color_init_from_array2 (col, c1)
	col%ghost = ghost
	end subroutine color_init_from_array2g

	@ %def color_init_from_array
	@ Set the ghost property
	<<Colors: color: TBP>>=
	procedure :: set_ghost => color_set_ghost
	<<Colors: sub interfaces>>=
	elemental module subroutine color_set_ghost (col, ghost)
	class(color_t), intent(inout) :: col
	logical, intent(in) :: ghost
	end subroutine color_set_ghost
	<<Colors: procedures>>=
	elemental module subroutine color_set_ghost (col, ghost)
	class(color_t), intent(inout) :: col
	logical, intent(in) :: ghost
	col%ghost = ghost
	end subroutine color_set_ghost

	@ %def color_set_ghost
	@ Undefine the color state:
	<<Colors: color: TBP>>=
	procedure :: undefine => color_undefine
	<<Colors: sub interfaces>>=
	elemental module subroutine color_undefine (col, undefine_ghost)
	class(color_t), intent(inout) :: col
	logical, intent(in), optional :: undefine_ghost
	end subroutine color_undefine
	<<Colors: procedures>>=
	elemental module subroutine color_undefine (col, undefine_ghost)
	class(color_t), intent(inout) :: col
	logical, intent(in), optional :: undefine_ghost
	col%defined = .false.
	if (present (undefine_ghost)) then
	if (undefine_ghost) col%ghost = .false.
	else
	col%ghost = .false.
	end if
	end subroutine color_undefine

	@ %def color_undefine
	@ Output. As dense as possible, no linebreak. If color is undefined,
	no output.

	The separate version for a color array suggest two distinct interfaces.
	<<Colors: public>>=
	public :: color_write
	<<Colors: interfaces>>=
	interface color_write
	module procedure color_write_single
	module procedure color_write_array
	end interface color_write

	<<Colors: color: TBP>>=
	procedure :: write => color_write_single
	<<Colors: sub interfaces>>=
	module subroutine color_write_single (col, unit)
	class(color_t), intent(in) :: col
	integer, intent(in), optional :: unit
	end subroutine color_write_single
	module subroutine color_write_array (col, unit)
	type(color_t), dimension(:), intent(in) :: col
	integer, intent(in), optional :: unit
	end subroutine color_write_array
	<<Colors: procedures>>=
	module subroutine color_write_single (col, unit)
	class(color_t), intent(in) :: col
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	if (col%ghost) then
	write (u, "(A)", advance="no") "c*"
	else if (col%defined) then
	write (u, "(A)", advance="no") "c("
	if (col%c1(1) /= 0) write (u, "(I0)", advance="no") col%c1(1)
	if (any (col%c1 /= 0)) write (u, "(1x)", advance="no")
	if (col%c1(2) /= 0) write (u, "(I0)", advance="no") col%c1(2)
	if (.not. col%is_diagonal ()) then
	write (u, "(A)", advance="no") "\|"
	if (col%c2(1) /= 0) write (u, "(I0)", advance="no") col%c2(1)
	if (any (col%c2 /= 0)) write (u, "(1x)", advance="no")
	if (col%c2(2) /= 0) write (u, "(I0)", advance="no") col%c2(2)
	end if
	write (u, "(A)", advance="no") ")"
	end if
	end subroutine color_write_single

	module subroutine color_write_array (col, unit)
	type(color_t), dimension(:), intent(in) :: col
	integer, intent(in), optional :: unit
	integer :: u
	integer :: i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A)", advance="no") "["
	do i = 1, size (col)
	if (i > 1) write (u, "(1x)", advance="no")
	call color_write_single (col(i), u)
	end do
	write (u, "(A)", advance="no") "]"
	end subroutine color_write_array

	@ %def color_write
	@ Binary I/O. For allocatable colors, this would have to be modified.
	<<Colors: color: TBP>>=
	procedure :: write_raw => color_write_raw
	procedure :: read_raw => color_read_raw
	<<Colors: sub interfaces>>=
	module subroutine color_write_raw (col, u)
	class(color_t), intent(in) :: col
	integer, intent(in) :: u
	end subroutine color_write_raw
	module subroutine color_read_raw (col, u, iostat)
	class(color_t), intent(inout) :: col
	integer, intent(in) :: u
	integer, intent(out), optional :: iostat
	end subroutine color_read_raw
	<<Colors: procedures>>=
	module subroutine color_write_raw (col, u)
	class(color_t), intent(in) :: col
	integer, intent(in) :: u
	logical :: defined
	defined = col%is_defined () .or. col%is_ghost ()
	write (u) defined
	if (defined) then
	write (u) col%c1, col%c2
	write (u) col%ghost
	end if
	end subroutine color_write_raw

	module subroutine color_read_raw (col, u, iostat)
	class(color_t), intent(inout) :: col
	integer, intent(in) :: u
	integer, intent(out), optional :: iostat
	logical :: defined
	read (u, iostat=iostat) col%defined
	if (col%defined) then
	read (u, iostat=iostat) col%c1, col%c2
	read (u, iostat=iostat) col%ghost
	end if
	end subroutine color_read_raw

	@ %def color_write_raw color_read_raw
	@
	\subsection{Predicates}
	Return the definition status. A color state may be defined but trivial.
	<<Colors: color: TBP>>=
	procedure :: is_defined => color_is_defined
	procedure :: is_nonzero => color_is_nonzero
	<<Colors: sub interfaces>>=
	elemental module function color_is_defined (col) result (defined)
	logical :: defined
	class(color_t), intent(in) :: col
	end function color_is_defined
	elemental module function color_is_nonzero (col) result (flag)
	logical :: flag
	class(color_t), intent(in) :: col
	end function color_is_nonzero
	<<Colors: procedures>>=
	elemental module function color_is_defined (col) result (defined)
	logical :: defined
	class(color_t), intent(in) :: col
	defined = col%defined
	end function color_is_defined

	elemental module function color_is_nonzero (col) result (flag)
	logical :: flag
	class(color_t), intent(in) :: col
	flag = col%defined &
	.and. .not. col%ghost &
	.and. any (col%c1 /= 0 .or. col%c2 /= 0)
	end function color_is_nonzero

	@ %def color_is_defined
	@ %def color_is_nonzero
	@ Diagonal color objects have only one array allocated:
	<<Colors: color: TBP>>=
	procedure :: is_diagonal => color_is_diagonal
	<<Colors: sub interfaces>>=
	elemental module function color_is_diagonal (col) result (diagonal)
	logical :: diagonal
	class(color_t), intent(in) :: col
	end function color_is_diagonal
	<<Colors: procedures>>=
	elemental module function color_is_diagonal (col) result (diagonal)
	logical :: diagonal
	class(color_t), intent(in) :: col
	if (col%defined) then
	diagonal = all (col%c1 == col%c2)
	else
	diagonal = .true.
	end if
	end function color_is_diagonal

	@ %def color_is_diagonal
	@ Return the ghost flag
	<<Colors: color: TBP>>=
	procedure :: is_ghost => color_is_ghost
	<<Colors: sub interfaces>>=
	elemental module function color_is_ghost (col) result (ghost)
	logical :: ghost
	class(color_t), intent(in) :: col
	end function color_is_ghost
	<<Colors: procedures>>=
	elemental module function color_is_ghost (col) result (ghost)
	logical :: ghost
	class(color_t), intent(in) :: col
	ghost = col%ghost
	end function color_is_ghost

	@ %def color_is_ghost
	@ The ghost parity: true if the color-ghost flag is set. Again, no
	TBP since this is an array.
	<<Colors: procedures>>=
	pure function color_ghost_parity (col) result (parity)
	type(color_t), dimension(:), intent(in) :: col
	logical :: parity
	parity = mod (count (col%ghost), 2) == 1
	end function color_ghost_parity

	@ %def color_ghost_parity
	@ Determine the color representation, given a color object. We allow
	only singlet ($1$), (anti)triplet ($\pm 3$), and octet states ($8$).
	A color ghost must not have color assigned, but the color type is $8$. For
	non-diagonal color, representations must match. If the color type is
	undefined, return $0$. If it is invalid or unsupported, return $-1$.

	Assumption: nonzero entries precede nonzero ones.
	<<Colors: color: TBP>>=
	procedure :: get_type => color_get_type
	<<Colors: sub interfaces>>=
	elemental module function color_get_type (col) result (ctype)
	class(color_t), intent(in) :: col
	integer :: ctype
	end function color_get_type
	<<Colors: procedures>>=
	elemental module function color_get_type (col) result (ctype)
	class(color_t), intent(in) :: col
	integer :: ctype
	if (col%defined) then
	ctype = -1
	if (col%ghost) then
	if (all (col%c1 == 0 .and. col%c2 == 0)) then
	ctype = 8
	end if
	else
	if (all ((col%c1 == 0 .and. col%c2 == 0) &
	& .or. (col%c1 > 0 .and. col%c2 > 0) &
	& .or. (col%c1 < 0 .and. col%c2 < 0))) then
	if (all (col%c1 == 0)) then
	ctype = 1
	else if ((col%c1(1) > 0 .and. col%c1(2) == 0)) then
	ctype = 3
	else if ((col%c1(1) < 0 .and. col%c1(2) == 0)) then
	ctype = -3
	else if ((col%c1(1) > 0 .and. col%c1(2) < 0) &
	.or.(col%c1(1) < 0 .and. col%c1(2) > 0)) then
	ctype = 8
	end if
	end if
	end if
	else
	ctype = 0
	end if
	end function color_get_type

	@ %def color_get_type
	@
	\subsection{Accessing contents}
	Return the number of color indices. We assume that it is identical
	for both arrays.
	<<Colors: color: TBP>>=
	procedure, private :: get_number_of_indices => color_get_number_of_indices
	<<Colors: sub interfaces>>=
	elemental module function color_get_number_of_indices (col) result (n)
	integer :: n
	class(color_t), intent(in) :: col
	end function color_get_number_of_indices
	<<Colors: procedures>>=
	elemental module function color_get_number_of_indices (col) result (n)
	integer :: n
	class(color_t), intent(in) :: col
	if (col%defined .and. .not. col%ghost) then
	n = count (col%c1 /= 0)
	else
	n = 0
	end if
	end function color_get_number_of_indices

	@ %def color_get_number_of_indices
	@ Return the (first) color/anticolor entry (assuming that color is
	diagonal). The result is a positive color index.
	<<Colors: color: TBP>>=
	procedure :: get_col => color_get_col
	procedure :: get_acl => color_get_acl
	<<Colors: sub interfaces>>=
	elemental module function color_get_col (col) result (c)
	integer :: c
	class(color_t), intent(in) :: col
	end function color_get_col
	elemental module function color_get_acl (col) result (c)
	integer :: c
	class(color_t), intent(in) :: col
	end function color_get_acl
	<<Colors: procedures>>=
	elemental module function color_get_col (col) result (c)
	integer :: c
	class(color_t), intent(in) :: col
	integer :: i
	if (col%defined .and. .not. col%ghost) then
	do i = 1, size (col%c1)
	if (col%c1(i) > 0) then
	c = col%c1(i)
	return
	end if
	end do
	end if
	c = 0
	end function color_get_col

	elemental module function color_get_acl (col) result (c)
	integer :: c
	class(color_t), intent(in) :: col
	integer :: i
	if (col%defined .and. .not. col%ghost) then
	do i = 1, size (col%c1)
	if (col%c1(i) < 0) then
	c = - col%c1(i)
	return
	end if
	end do
	end if
	c = 0
	end function color_get_acl

	@ %def color_get_col color_get_acl
	@ Return the color index with highest absolute value
	<<Colors: public>>=
	public :: color_get_max_value
	<<Colors: interfaces>>=
	interface color_get_max_value
	module procedure color_get_max_value0
	module procedure color_get_max_value1
	module procedure color_get_max_value2
	end interface color_get_max_value

	<<Colors: sub interfaces>>=
	elemental module function color_get_max_value0 (col) result (cmax)
	integer :: cmax
	type(color_t), intent(in) :: col
	end function color_get_max_value0
	pure module function color_get_max_value1 (col) result (cmax)
	integer :: cmax
	type(color_t), dimension(:), intent(in) :: col
	end function color_get_max_value1
	pure module function color_get_max_value2 (col) result (cmax)
	integer :: cmax
	type(color_t), dimension(:,:), intent(in) :: col
	end function color_get_max_value2
	<<Colors: procedures>>=
	elemental module function color_get_max_value0 (col) result (cmax)
	integer :: cmax
	type(color_t), intent(in) :: col
	if (col%defined .and. .not. col%ghost) then
	cmax = maxval (abs (col%c1))
	else
	cmax = 0
	end if
	end function color_get_max_value0

	pure module function color_get_max_value1 (col) result (cmax)
	integer :: cmax
	type(color_t), dimension(:), intent(in) :: col
	cmax = maxval (color_get_max_value0 (col))
	end function color_get_max_value1

	pure module function color_get_max_value2 (col) result (cmax)
	integer :: cmax
	type(color_t), dimension(:,:), intent(in) :: col
	integer, dimension(size(col, 2)) :: cm
	integer :: i
	forall (i = 1:size(col, 2))
	cm(i) = color_get_max_value1 (col(:,i))
	end forall
	cmax = maxval (cm)
	end function color_get_max_value2

	@ %def color_get_max_value
	@
	\subsection{Comparisons}
	Similar to helicities, colors match if they are equal, or if either
	one is undefined.
	<<Colors: color: TBP>>=
	generic :: operator(.match.) => color_match
	generic :: operator(==) => color_eq
	generic :: operator(/=) => color_neq
	procedure, private :: color_match
	procedure, private :: color_eq
	procedure, private :: color_neq
	@ %def .match. == /=
	<<Colors: sub interfaces>>=
	elemental module function color_match (col1, col2) result (eq)
	logical :: eq
	class(color_t), intent(in) :: col1, col2
	end function color_match
	elemental module function color_eq (col1, col2) result (eq)
	logical :: eq
	class(color_t), intent(in) :: col1, col2
	end function color_eq
	<<Colors: procedures>>=
	elemental module function color_match (col1, col2) result (eq)
	logical :: eq
	class(color_t), intent(in) :: col1, col2
	if (col1%defined .and. col2%defined) then
	if (col1%ghost .and. col2%ghost) then
	eq = .true.
	else if (.not. col1%ghost .and. .not. col2%ghost) then
	eq = all (col1%c1 == col2%c1) .and. all (col1%c2 == col2%c2)
	else
	eq = .false.
	end if
	else
	eq = .true.
	end if
	end function color_match

	elemental module function color_eq (col1, col2) result (eq)
	logical :: eq
	class(color_t), intent(in) :: col1, col2
	if (col1%defined .and. col2%defined) then
	if (col1%ghost .and. col2%ghost) then
	eq = .true.
	else if (.not. col1%ghost .and. .not. col2%ghost) then
	eq = all (col1%c1 == col2%c1) .and. all (col1%c2 == col2%c2)
	else
	eq = .false.
	end if
	else if (.not. col1%defined &
	.and. .not. col2%defined) then
	eq = col1%ghost .eqv. col2%ghost
	else
	eq = .false.
	end if
	end function color_eq

	@ %def color_eq
	<<Colors: sub interfaces>>=
	elemental module function color_neq (col1, col2) result (neq)
	logical :: neq
	class(color_t), intent(in) :: col1, col2
	end function color_neq
	<<Colors: procedures>>=
	elemental module function color_neq (col1, col2) result (neq)
	logical :: neq
	class(color_t), intent(in) :: col1, col2
	if (col1%defined .and. col2%defined) then
	if (col1%ghost .and. col2%ghost) then
	neq = .false.
	else if (.not. col1%ghost .and. .not. col2%ghost) then
	neq = any (col1%c1 /= col2%c1) .or. any (col1%c2 /= col2%c2)
	else
	neq = .true.
	end if
	else if (.not. col1%defined &
	.and. .not. col2%defined) then
	neq = col1%ghost .neqv. col2%ghost
	else
	neq = .true.
	end if
	end function color_neq

	@ %def color_neq
	@
	\subsection{Tools}
	Shift color indices by a common offset.
	<<Colors: color: TBP>>=
	procedure :: add_offset => color_add_offset
	<<Colors: sub interfaces>>=
	elemental module subroutine color_add_offset (col, offset)
	class(color_t), intent(inout) :: col
	integer, intent(in) :: offset
	end subroutine color_add_offset
	<<Colors: procedures>>=
	elemental module subroutine color_add_offset (col, offset)
	class(color_t), intent(inout) :: col
	integer, intent(in) :: offset
	if (col%defined .and. .not. col%ghost) then
	where (col%c1 /= 0) col%c1 = col%c1 + sign (offset, col%c1)
	where (col%c2 /= 0) col%c2 = col%c2 + sign (offset, col%c2)
	end if
	end subroutine color_add_offset

	@ %def color_add_offset
	@ Reassign color indices for an array of colored particle in canonical
	order. The allocated size of the color map is such that two colors
	per particle can be accomodated.

	The algorithm works directly on the contents of the color objects, it
	<<Colors: public>>=
	public :: color_canonicalize
	<<Colors: sub interfaces>>=
	module subroutine color_canonicalize (col)
	type(color_t), dimension(:), intent(inout) :: col
	end subroutine color_canonicalize
	<<Colors: procedures>>=
	module subroutine color_canonicalize (col)
	type(color_t), dimension(:), intent(inout) :: col
	integer, dimension(2*size(col)) :: map
	integer :: n_col, i, j, k
	n_col = 0
	do i = 1, size (col)
	if (col(i)%defined .and. .not. col(i)%ghost) then
	do j = 1, size (col(i)%c1)
	if (col(i)%c1(j) /= 0) then
	k = find (abs (col(i)%c1(j)), map(:n_col))
	if (k == 0) then
	n_col = n_col + 1
	map(n_col) = abs (col(i)%c1(j))
	k = n_col
	end if
	col(i)%c1(j) = sign (k, col(i)%c1(j))
	end if
	if (col(i)%c2(j) /= 0) then
	k = find (abs (col(i)%c2(j)), map(:n_col))
	if (k == 0) then
	n_col = n_col + 1
	map(n_col) = abs (col(i)%c2(j))
	k = n_col
	end if
	col(i)%c2(j) = sign (k, col(i)%c2(j))
	end if
	end do
	end if
	end do
	contains
	function find (c, array) result (k)
	integer :: k
	integer, intent(in) :: c
	integer, dimension(:), intent(in) :: array
	integer :: i
	k = 0
	do i = 1, size (array)
	if (c == array (i)) then
	k = i
	return
	end if
	end do
	end function find
	end subroutine color_canonicalize

	@ %def color_canonicalize
	@ Return an array of different color indices from an array of colors.
	The last argument is a pseudo-color array, where the color entries
	correspond to the position of the corresponding index entry in the
	index array. The colors are assumed to be diagonal.

	The algorithm works directly on the contents of the color objects.
	<<Colors: procedures>>=
	subroutine extract_color_line_indices (col, c_index, col_pos)
	type(color_t), dimension(:), intent(in) :: col
	integer, dimension(:), intent(out), allocatable :: c_index
	type(color_t), dimension(size(col)), intent(out) :: col_pos
	integer, dimension(:), allocatable :: c_tmp
	integer :: i, j, k, n, c
	allocate (c_tmp (sum (col%get_number_of_indices ())), source=0)
	n = 0
	SCAN1: do i = 1, size (col)
	if (col(i)%defined .and. .not. col(i)%ghost) then
	SCAN2: do j = 1, 2
	c = abs (col(i)%c1(j))
	if (c /= 0) then
	do k = 1, n
	if (c_tmp(k) == c) then
	col_pos(i)%c1(j) = k
	cycle SCAN2
	end if
	end do
	n = n + 1
	c_tmp(n) = c
	col_pos(i)%c1(j) = n
	end if
	end do SCAN2
	end if
	end do SCAN1
	allocate (c_index (n))
	c_index = c_tmp(1:n)
	end subroutine extract_color_line_indices

	@ %def extract_color_line_indices
	@ Given a color array, pairwise contract the color lines in all
	possible ways and return the resulting array of arrays. The input
	color array must be diagonal, and each color should occur exactly
	twice, once as color and once as anticolor.

	Gluon entries with equal color and anticolor are explicitly excluded.

	This algorithm is generic, but for long arrays it is neither
	efficient, nor does it avoid duplicates. It is intended for small
	arrays, in particular for the state matrix of a structure-function
	pair.

	The algorithm works directly on the contents of the color objects, it
	thus depends on the implementation.
	<<Colors: public>>=
	public :: color_array_make_contractions
	<<Colors: sub interfaces>>=
	module subroutine color_array_make_contractions (col_in, col_out)
	type(color_t), dimension(:), intent(in) :: col_in
	type(color_t), dimension(:,:), intent(out), allocatable :: col_out
	end subroutine color_array_make_contractions
	<<Colors: procedures>>=
	module subroutine color_array_make_contractions (col_in, col_out)
	type(color_t), dimension(:), intent(in) :: col_in
	type(color_t), dimension(:,:), intent(out), allocatable :: col_out
	type(list_t) :: list
	type(entry_t), pointer :: entry
	integer, dimension(:), allocatable :: c_index
	type(color_t), dimension(size(col_in)) :: col_pos
	integer :: n_prt, n_c_index
	integer, dimension(:), allocatable :: map
	integer :: i, j, c
	n_prt = size (col_in)
	call extract_color_line_indices (col_in, c_index, col_pos)
	n_c_index = size (c_index)
	allocate (map (n_c_index))
	map = 0
	call list_append_if_valid (list, map)
	entry => list%first
	do while (associated (entry))
	do i = 1, n_c_index
	if (entry%map(i) == 0) then
	c = c_index(i)
	do j = i + 1, n_c_index
	if (entry%map(j) == 0) then
	map = entry%map
	map(i) = c
	map(j) = c
	call list_append_if_valid (list, map)
	end if
	end do
	end if
	end do
	entry => entry%next
	end do
	call list_to_array (list, col_out)
	contains
	subroutine list_append_if_valid (list, map)
	type(list_t), intent(inout) :: list
	integer, dimension(:), intent(in) :: map
	type(entry_t), pointer :: entry
	integer :: i, j, c, p
	entry => list%first
	do while (associated (entry))
	if (all (map == entry%map)) return
	entry => entry%next
	end do
	allocate (entry)
	allocate (entry%map (n_c_index))
	entry%map = map
	allocate (entry%col (n_prt))
	do i = 1, n_prt
	do j = 1, 2
	c = col_in(i)%c1(j)
	if (c /= 0) then
	p = col_pos(i)%c1(j)
	entry%col(i)%defined = .true.
	if (map(p) /= 0) then
	entry%col(i)%c1(j) = sign (map(p), c)
	else
	entry%col(i)%c1(j) = c
	endif
	entry%col(i)%c2(j) = entry%col(i)%c1(j)
	end if
	end do
	if (any (entry%col(i)%c1 /= 0) .and. &
	entry%col(i)%c1(1) == - entry%col(i)%c1(2)) return
	end do
	if (associated (list%last)) then
	list%last%next => entry
	else
	list%first => entry
	end if
	list%last => entry
	list%n = list%n + 1
	end subroutine list_append_if_valid
	subroutine list_to_array (list, col)
	type(list_t), intent(inout) :: list
	type(color_t), dimension(:,:), intent(out), allocatable :: col
	type(entry_t), pointer :: entry
	integer :: i
	allocate (col (n_prt, list%n - 1))
	do i = 0, list%n - 1
	entry => list%first
	list%first => list%first%next
	if (i /= 0) col(:,i) = entry%col
	deallocate (entry)
	end do
	list%last => null ()
	end subroutine list_to_array
	end subroutine color_array_make_contractions

	@ %def color_array_make_contractions
	@ Invert the color index, switching from particle to antiparticle.
	For gluons, we have to swap the order of color entries.
	<<Colors: color: TBP>>=
	procedure :: invert => color_invert
	<<Colors: sub interfaces>>=
	elemental module subroutine color_invert (col)
	class(color_t), intent(inout) :: col
	end subroutine color_invert
	<<Colors: procedures>>=
	elemental module subroutine color_invert (col)
	class(color_t), intent(inout) :: col
	if (col%defined .and. .not. col%ghost) then
	col%c1 = - col%c1
	col%c2 = - col%c2
	if (col%c1(1) < 0 .and. col%c1(2) > 0) then
	col%c1 = col%c1(2:1:-1)
	col%c2 = col%c2(2:1:-1)
	end if
	end if
	end subroutine color_invert

	@ %def color_invert
	@ Make a color map for two matching color arrays. The result is an
	array of integer pairs.
	<<Colors: public>>=
	public :: make_color_map
	<<Colors: interfaces>>=
	interface make_color_map
	module procedure color_make_color_map
	end interface make_color_map

	<<Colors: sub interfaces>>=
	module subroutine color_make_color_map (map, col1, col2)
	integer, dimension(:,:), intent(out), allocatable :: map
	type(color_t), dimension(:), intent(in) :: col1, col2
	end subroutine color_make_color_map
	<<Colors: procedures>>=
	module subroutine color_make_color_map (map, col1, col2)
	integer, dimension(:,:), intent(out), allocatable :: map
	type(color_t), dimension(:), intent(in) :: col1, col2
	integer, dimension(:,:), allocatable :: map1
	integer :: i, j, k
	allocate (map1 (2, 2 * sum (col1%get_number_of_indices ())))
	k = 0
	do i = 1, size (col1)
	if (col1(i)%defined .and. .not. col1(i)%ghost) then
	do j = 1, size (col1(i)%c1)
	if (col1(i)%c1(j) /= 0 &
	.and. all (map1(1,:k) /= abs (col1(i)%c1(j)))) then
	k = k + 1
	map1(1,k) = abs (col1(i)%c1(j))
	map1(2,k) = abs (col2(i)%c1(j))
	end if
	if (col1(i)%c2(j) /= 0 &
	.and. all (map1(1,:k) /= abs (col1(i)%c2(j)))) then
	k = k + 1
	map1(1,k) = abs (col1(i)%c2(j))
	map1(2,k) = abs (col2(i)%c2(j))
	end if
	end do
	end if
	end do
	allocate (map (2, k))
	map(:,:) = map1(:,:k)
	end subroutine color_make_color_map

	@ %def make_color_map
	@ Translate colors which have a match in the translation table (an
	array of integer pairs). Color that do not match an entry are simply
	transferred; this is done by first transferring all components, then
	modifiying entries where appropriate.
	<<Colors: public>>=
	public :: color_translate
	<<Colors: interfaces>>=
	interface color_translate
	module procedure color_translate0
	module procedure color_translate0_offset
	module procedure color_translate1
	end interface color_translate

	<<Colors: sub interfaces>>=
	module subroutine color_translate0 (col, map)
	type(color_t), intent(inout) :: col
	integer, dimension(:,:), intent(in) :: map
	end subroutine color_translate0
	module subroutine color_translate0_offset (col, map, offset)
	type(color_t), intent(inout) :: col
	integer, dimension(:,:), intent(in) :: map
	integer, intent(in) :: offset
	end subroutine color_translate0_offset
	module subroutine color_translate1 (col, map, offset)
	type(color_t), dimension(:), intent(inout) :: col
	integer, dimension(:,:), intent(in) :: map
	integer, intent(in), optional :: offset
	end subroutine color_translate1
	<<Colors: procedures>>=
	module subroutine color_translate0 (col, map)
	type(color_t), intent(inout) :: col
	integer, dimension(:,:), intent(in) :: map
	type(color_t) :: col_tmp
	integer :: i
	if (col%defined .and. .not. col%ghost) then
	col_tmp = col
	do i = 1, size (map,2)
	where (abs (col%c1) == map(1,i))
	col_tmp%c1 = sign (map(2,i), col%c1)
	end where
	where (abs (col%c2) == map(1,i))
	col_tmp%c2 = sign (map(2,i), col%c2)
	end where
	end do
	col = col_tmp
	end if
	end subroutine color_translate0

	module subroutine color_translate0_offset (col, map, offset)
	type(color_t), intent(inout) :: col
	integer, dimension(:,:), intent(in) :: map
	integer, intent(in) :: offset
	logical, dimension(size(col%c1)) :: mask1, mask2
	type(color_t) :: col_tmp
	integer :: i
	if (col%defined .and. .not. col%ghost) then
	col_tmp = col
	mask1 = col%c1 /= 0
	mask2 = col%c2 /= 0
	do i = 1, size (map,2)
	where (abs (col%c1) == map(1,i))
	col_tmp%c1 = sign (map(2,i), col%c1)
	mask1 = .false.
	end where
	where (abs (col%c2) == map(1,i))
	col_tmp%c2 = sign (map(2,i), col%c2)
	mask2 = .false.
	end where
	end do
	col = col_tmp
	where (mask1) col%c1 = sign (abs (col%c1) + offset, col%c1)
	where (mask2) col%c2 = sign (abs (col%c2) + offset, col%c2)
	end if
	end subroutine color_translate0_offset

	module subroutine color_translate1 (col, map, offset)
	type(color_t), dimension(:), intent(inout) :: col
	integer, dimension(:,:), intent(in) :: map
	integer, intent(in), optional :: offset
	integer :: i
	if (present (offset)) then
	do i = 1, size (col)
	call color_translate0_offset (col(i), map, offset)
	end do
	else
	do i = 1, size (col)
	call color_translate0 (col(i), map)
	end do
	end if
	end subroutine color_translate1

	@ %def color_translate
	@ Merge two color objects by taking the first entry from the first and
	the first entry from the second argument. Makes sense only if the
	input colors are defined (and diagonal). If either one is undefined,
	transfer the defined one.
	<<Colors: color: TBP>>=
	generic :: operator(.merge.) => merge_colors
	procedure, private :: merge_colors
	@ %def .merge.
	<<Colors: sub interfaces>>=
	elemental module function merge_colors (col1, col2) result (col)
	type(color_t) :: col
	class(color_t), intent(in) :: col1, col2
	end function merge_colors
	<<Colors: procedures>>=
	elemental module function merge_colors (col1, col2) result (col)
	type(color_t) :: col
	class(color_t), intent(in) :: col1, col2
	if (color_is_defined (col1) .and. color_is_defined (col2)) then
	if (color_is_ghost (col1) .and. color_is_ghost (col2)) then
	call color_init_trivial_ghost (col, .true.)
	else
	call color_init_arrays (col, col1%c1, col2%c1)
	end if
	else if (color_is_defined (col1)) then
	call color_init_array (col, col1%c1)
	else if (color_is_defined (col2)) then
	call color_init_array (col, col2%c1)
	end if
	end function merge_colors

	@ %def merge_colors
	@ Merge up to two (diagonal!) color objects. The result inherits the unmatched
	color lines of the input colors. If one of the input colors is
	undefined, the output is undefined as well. It must be in a supported
	color representation.

	A color-ghost object should not actually occur in real-particle
	events, but for completeness we define its behavior. For simplicity,
	it is identified as a color-octet with zero color/anticolor. It can
	only couple to a triplet or antitriplet. A fusion of triplet with
	matching antitriplet will yield a singlet, not a ghost, however.

	If the fusion fails, the result is undefined.
	<<Colors: color: TBP>>=
	generic :: operator (.fuse.) => color_fusion
	procedure, private :: color_fusion
	<<Colors: sub interfaces>>=
	module function color_fusion (col1, col2) result (col)
	class(color_t), intent(in) :: col1, col2
	type(color_t) :: col
	end function color_fusion
	<<Colors: procedures>>=
	module function color_fusion (col1, col2) result (col)
	class(color_t), intent(in) :: col1, col2
	type(color_t) :: col
	integer, dimension(2) :: ctype
	if (col1%is_defined () .and. col2%is_defined ()) then
	if (col1%is_diagonal () .and. col2%is_diagonal ()) then
	ctype = [col1%get_type (), col2%get_type ()]
	select case (ctype(1))
	case (1)
	select case (ctype(2))
	case (1,3,-3,8)
	col = col2
	end select
	case (3)
	select case (ctype(2))
	case (1)
	col = col1
	case (-3)
	call t_a (col1%get_col (), col2%get_acl ())
	case (8)
	call t_o (col1%get_col (), col2%get_acl (), &
	& col2%get_col ())
	end select
	case (-3)
	select case (ctype(2))
	case (1)
	col = col1
	case (3)
	call t_a (col2%get_col (), col1%get_acl ())
	case (8)
	call a_o (col1%get_acl (), col2%get_col (), &
	& col2%get_acl ())
	end select
	case (8)
	select case (ctype(2))
	case (1)
	col = col1
	case (3)
	call t_o (col2%get_col (), col1%get_acl (), &
	& col1%get_col ())
	case (-3)
	call a_o (col2%get_acl (), col1%get_col (), &
	& col1%get_acl ())
	case (8)
	call o_o (col1%get_col (), col1%get_acl (), &
	& col2%get_col (), col2%get_acl ())
	end select
	end select
	end if
	end if
	contains
	subroutine t_a (c1, c2)
	integer, intent(in) :: c1, c2
	if (c1 == c2) then
	call col%init_col_acl (0, 0)
	else
	call col%init_col_acl (c1, c2)
	end if
	end subroutine t_a
	subroutine t_o (c1, c2, c3)
	integer, intent(in) :: c1, c2, c3
	if (c1 == c2) then
	call col%init_col_acl (c3, 0)
	else if (c2 == 0 .and. c3 == 0) then
	call col%init_col_acl (c1, 0)
	end if
	end subroutine t_o
	subroutine a_o (c1, c2, c3)
	integer, intent(in) :: c1, c2, c3
	if (c1 == c2) then
	call col%init_col_acl (0, c3)
	else if (c2 == 0 .and. c3 == 0) then
	call col%init_col_acl (0, c1)
	end if
	end subroutine a_o
	subroutine o_o (c1, c2, c3, c4)
	integer, intent(in) :: c1, c2, c3, c4
	if (all ([c1,c2,c3,c4] /= 0)) then
	if (c2 == c3 .and. c4 == c1) then
	call col%init_col_acl (0, 0)
	else if (c2 == c3) then
	call col%init_col_acl (c1, c4)
	else if (c4 == c1) then
	call col%init_col_acl (c3, c2)
	end if
	end if
	end subroutine o_o
	end function color_fusion

	@ %def color_fusion
	@ Compute the color factor, given two interfering color arrays.
	<<Colors: public>>=
	public :: compute_color_factor
	<<Colors: sub interfaces>>=
	module function compute_color_factor (col1, col2, nc) result (factor)
	real(default) :: factor
	type(color_t), dimension(:), intent(in) :: col1, col2
	integer, intent(in), optional :: nc
	end function compute_color_factor
	<<Colors: procedures>>=
	module function compute_color_factor (col1, col2, nc) result (factor)
	real(default) :: factor
	type(color_t), dimension(:), intent(in) :: col1, col2
	integer, intent(in), optional :: nc
	type(color_t), dimension(size(col1)) :: col
	integer :: ncol, nloops, nghost
	ncol = 3; if (present (nc)) ncol = nc
	col = col1 .merge. col2
	nloops = count_color_loops (col)
	nghost = count (col%is_ghost ())
	factor = real (ncol, default) ** (nloops - nghost)
	if (color_ghost_parity (col)) factor = - factor
	end function compute_color_factor

	@ %def compute_color_factor
	@
	We have a pair of color index arrays which corresponds to a squared
	matrix element. We want to determine the number of color loops in
	this square matrix element. So we first copy the colors (stored in a
	single color array with a pair of color lists in each entry) to a
	temporary where the color indices are shifted by some offset. We then
	recursively follow each loop, starting at the first color that has the
	offset, resetting the first color index to the loop index and each
	further index to zero as we go. We check that (a) each color index
	occurs twice within the left (right) color array, (b) the loops are
	closed, so we always come back to a line which has the loop index.

	In order for the algorithm to work we have to conjugate the colors of
	initial state particles (one for decays, two for scatterings) into
	their corresponding anticolors of outgoing particles.
	<<Colors: public>>=
	public :: count_color_loops
	<<Colors: sub interfaces>>=
	module function count_color_loops (col) result (count)
	integer :: count
	type(color_t), dimension(:), intent(in) :: col
	end function count_color_loops
	<<Colors: procedures>>=
	module function count_color_loops (col) result (count)
	integer :: count
	type(color_t), dimension(:), intent(in) :: col
	type(color_t), dimension(size(col)) :: cc
	integer :: i, n, offset
	cc = col
	n = size (cc)
	offset = n
	call color_add_offset (cc, offset)
	count = 0
	SCAN_LOOPS: do
	do i = 1, n
	if (color_is_nonzero (cc(i))) then
	if (any (cc(i)%c1 > offset)) then
	count = count + 1
	call follow_line1 (pick_new_line (cc(i)%c1, count, 1))
	cycle SCAN_LOOPS
	end if
	end if
	end do
	exit SCAN_LOOPS
	end do SCAN_LOOPS
	contains
	function pick_new_line (c, reset_val, sgn) result (line)
	integer :: line
	integer, dimension(:), intent(inout) :: c
	integer, intent(in) :: reset_val
	integer, intent(in) :: sgn
	integer :: i
	if (any (c == count)) then
	line = count
	else
	do i = 1, size (c)
	if (sign (1, c(i)) == sgn .and. abs (c(i)) > offset) then
	line = c(i)
	c(i) = reset_val
	return
	end if
	end do
	call color_mismatch
	end if
	end function pick_new_line

	subroutine reset_line (c, line)
	integer, dimension(:), intent(inout) :: c
	integer, intent(in) :: line
	integer :: i
	do i = 1, size (c)
	if (c(i) == line) then
	c(i) = 0
	return
	end if
	end do
	end subroutine reset_line

	recursive subroutine follow_line1 (line)
	integer, intent(in) :: line
	integer :: i
	if (line == count) return
	do i = 1, n
	if (any (cc(i)%c1 == -line)) then
	call reset_line (cc(i)%c1, -line)
	call follow_line2 (pick_new_line (cc(i)%c2, 0, sign (1, -line)))
	return
	end if
	end do
	call color_mismatch ()
	end subroutine follow_line1

	recursive subroutine follow_line2 (line)
	integer, intent(in) :: line
	integer :: i
	do i = 1, n
	if (any (cc(i)%c2 == -line)) then
	call reset_line (cc(i)%c2, -line)
	call follow_line1 (pick_new_line (cc(i)%c1, 0, sign (1, -line)))
	return
	end if
	end do
	call color_mismatch ()
	end subroutine follow_line2

	subroutine color_mismatch ()
	call color_write (col)
	print *
	call msg_fatal ("Color flow mismatch: Non-closed color lines appear during ", &
	[var_str ("the evaluation of color correlations. This can happen if there "), &
	var_str ("are different color structures in the initial or final state of "), &
	var_str ("the process definition. If so, please use separate processes for "), &
	var_str ("the different initial / final states. In a future WHIZARD version "), &
	var_str ("this will be fixed.")])
	end subroutine color_mismatch
	end function count_color_loops

	@ %def count_color_loops
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[colors_ut.f90]]>>=
	<<File header>>

	module colors_ut
	use unit_tests
	use colors_uti

	<<Standard module head>>

	<<Colors: public test>>

	contains

	<<Colors: test driver>>

	end module colors_ut
	@ %def colors_ut
	@
	<<[[colors_uti.f90]]>>=
	<<File header>>

	module colors_uti

	use colors

	<<Standard module head>>

	<<Colors: test declarations>>

	contains

	<<Colors: tests>>

	end module colors_uti
	@ %def colors_ut
	@ API: driver for the unit tests below.
	<<Colors: public test>>=
	public :: color_test
	<<Colors: test driver>>=
	subroutine color_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Colors: execute tests>>
	end subroutine color_test

	@ %def color_test
	@ This is a color counting test.
	<<Colors: execute tests>>=
	call test (color_1, "color_1", &
	"check color counting", &
	u, results)
	<<Colors: test declarations>>=
	public :: color_1
	<<Colors: tests>>=
	subroutine color_1 (u)
	integer, intent(in) :: u
	type(color_t), dimension(4) :: col1, col2, col
	type(color_t), dimension(:), allocatable :: col3
	type(color_t), dimension(:,:), allocatable :: col_array
	integer :: count, i
	call col1%init_col_acl ([1, 0, 2, 3], [0, 1, 3, 2])
	col2 = col1
	call color_write (col1, u)
	write (u, "(A)")
	call color_write (col2, u)
	write (u, "(A)")
	col = col1 .merge. col2
	call color_write (col, u)
	write (u, "(A)")
	count = count_color_loops (col)
	write (u, "(A,I1)") "Number of color loops (3): ", count
	call col2%init_col_acl ([1, 0, 2, 3], [0, 2, 3, 1])
	call color_write (col1, u)
	write (u, "(A)")
	call color_write (col2, u)
	write (u, "(A)")
	col = col1 .merge. col2
	call color_write (col, u)
	write (u, "(A)")
	count = count_color_loops (col)
	write (u, "(A,I1)") "Number of color loops (2): ", count
	write (u, "(A)")
	allocate (col3 (4))
	call color_init_from_array (col3, &
	reshape ([1, 0, 0, -1, 2, -3, 3, -2], &
	[2, 4]))
	call color_write (col3, u)
	write (u, "(A)")
	call color_array_make_contractions (col3, col_array)
	write (u, "(A)") "Contractions:"
	do i = 1, size (col_array, 2)
	call color_write (col_array(:,i), u)
	write (u, "(A)")
	end do
	deallocate (col3)
	write (u, "(A)")
	allocate (col3 (6))
	call color_init_from_array (col3, &
	reshape ([1, -2, 3, 0, 0, -1, 2, -4, -3, 0, 4, 0], &
	[2, 6]))
	call color_write (col3, u)
	write (u, "(A)")
	call color_array_make_contractions (col3, col_array)
	write (u, "(A)") "Contractions:"
	do i = 1, size (col_array, 2)
	call color_write (col_array(:,i), u)
	write (u, "(A)")
	end do
	end subroutine color_1

	@ %def color_1
	@ A color fusion test.
	<<Colors: execute tests>>=
	call test (color_2, "color_2", &
	"color fusion", &
	u, results)
	<<Colors: test declarations>>=
	public :: color_2
	<<Colors: tests>>=
	subroutine color_2 (u)
	integer, intent(in) :: u
	type(color_t) :: s1, t1, t2, a1, a2, o1, o2, o3, o4, g1

	write (u, "(A)") "* Test output: color_2"
	write (u, "(A)") "* Purpose: test all combinations for color-object fusion"
	write (u, "(A)")

	call s1%init_col_acl (0,0)
	call t1%init_col_acl (1,0)
	call t2%init_col_acl (2,0)
	call a1%init_col_acl (0,1)
	call a2%init_col_acl (0,2)
	call o1%init_col_acl (1,2)
	call o2%init_col_acl (1,3)
	call o3%init_col_acl (2,3)
	call o4%init_col_acl (2,1)
	call g1%init (ghost=.true.)

	call wrt ("s1", s1)
	call wrt ("t1", t1)
	call wrt ("t2", t2)
	call wrt ("a1", a1)
	call wrt ("a2", a2)
	call wrt ("o1", o1)
	call wrt ("o2", o2)
	call wrt ("o3", o3)
	call wrt ("o4", o4)
	call wrt ("g1", g1)

	write (u, *)

	call wrt ("s1 * s1", s1 .fuse. s1)

	write (u, *)

	call wrt ("s1 * t1", s1 .fuse. t1)
	call wrt ("s1 * a1", s1 .fuse. a1)
	call wrt ("s1 * o1", s1 .fuse. o1)

	write (u, *)

	call wrt ("t1 * s1", t1 .fuse. s1)
	call wrt ("a1 * s1", a1 .fuse. s1)
	call wrt ("o1 * s1", o1 .fuse. s1)

	write (u, *)

	call wrt ("t1 * t1", t1 .fuse. t1)

	write (u, *)

	call wrt ("t1 * t2", t1 .fuse. t2)
	call wrt ("t1 * a1", t1 .fuse. a1)
	call wrt ("t1 * a2", t1 .fuse. a2)
	call wrt ("t1 * o1", t1 .fuse. o1)
	call wrt ("t2 * o1", t2 .fuse. o1)

	write (u, *)

	call wrt ("t2 * t1", t2 .fuse. t1)
	call wrt ("a1 * t1", a1 .fuse. t1)
	call wrt ("a2 * t1", a2 .fuse. t1)
	call wrt ("o1 * t1", o1 .fuse. t1)
	call wrt ("o1 * t2", o1 .fuse. t2)

	write (u, *)

	call wrt ("a1 * a1", a1 .fuse. a1)

	write (u, *)

	call wrt ("a1 * a2", a1 .fuse. a2)
	call wrt ("a1 * o1", a1 .fuse. o1)
	call wrt ("a2 * o2", a2 .fuse. o2)

	write (u, *)

	call wrt ("a2 * a1", a2 .fuse. a1)
	call wrt ("o1 * a1", o1 .fuse. a1)
	call wrt ("o2 * a2", o2 .fuse. a2)

	write (u, *)

	call wrt ("o1 * o1", o1 .fuse. o1)

	write (u, *)

	call wrt ("o1 * o2", o1 .fuse. o2)
	call wrt ("o1 * o3", o1 .fuse. o3)
	call wrt ("o1 * o4", o1 .fuse. o4)

	write (u, *)

	call wrt ("o2 * o1", o2 .fuse. o1)
	call wrt ("o3 * o1", o3 .fuse. o1)
	call wrt ("o4 * o1", o4 .fuse. o1)

	write (u, *)

	call wrt ("g1 * g1", g1 .fuse. g1)

	write (u, *)

	call wrt ("g1 * s1", g1 .fuse. s1)
	call wrt ("g1 * t1", g1 .fuse. t1)
	call wrt ("g1 * a1", g1 .fuse. a1)
	call wrt ("g1 * o1", g1 .fuse. o1)

	write (u, *)

	call wrt ("s1 * g1", s1 .fuse. g1)
	call wrt ("t1 * g1", t1 .fuse. g1)
	call wrt ("a1 * g1", a1 .fuse. g1)
	call wrt ("o1 * g1", o1 .fuse. g1)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: color_2"

	contains

	subroutine wrt (s, col)
	character(*), intent(in) :: s
	class(color_t), intent(in) :: col
	write (u, "(A,1x,'=',1x)", advance="no") s
	call col%write (u)
	write (u, *)
	end subroutine wrt

	end subroutine color_2

	@ %def color_2
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\subsection{The Madgraph color model}
	This section describes the method for matrix element and color
	flow calculation within Madgraph.

	For each Feynman diagram, the colorless amplitude for a specified
	helicity and momentum configuration (in- and out- combined) is
	computed:
	\begin{equation}
	A_d(p,h)
	\end{equation}
	Inserting color, the squared matrix element for definite helicity and
	momentum is
	\begin{equation}
	M^2(p,h) = \sum_{dd'} A_{d}(p,h)\,C_{dd'} A_{d'}^*(p,h)
	\end{equation}
	where $C_{dd'}$ describes the color interference of the two diagrams
	$A_d$ and $A_d'$, which is independent of momentum and helicity and
	can be calculated for each Feynman diagram pair by reducing it to the
	corresponding color graph. Obviously, one could combine all diagrams
	with identical color structure, such that the index $d$ runs only over
	different color graphs. For colorless diagrams all elements of
	$C_{dd'}$ are equal to unity.

	The hermitian matrix $C_{dd'}$ is diagonalized once and for all, such
	that it can be written in the form
	\begin{equation}
	C_{dd'} = \sum_\lambda c_d^\lambda \lambda\, c_d^\lambda{}^*,
	\end{equation}
	where the eigenvectors $c_d$ are normalized,
	\begin{equation}
	\sum_d \|c_d^\lambda\|^2 = 1,
	\end{equation}
	and the $\lambda$ values are the corresponding eigenvalues. In the
	colorless case, this means $c_d = 1/\sqrt{N_d}$ for all diagrams
	($N_d=$ number of diagrams), and $\lambda=N_d$ is the only nonzero
	eigenvalue.

	Consequently, the squared matrix element for definite helicity and
	momentum can also be written as
	\begin{equation}
	M^2(p,h) = \sum_\lambda A_\lambda(p,h)\, \lambda\, A_\lambda(p,h)^*
	\end{equation}
	with
	\begin{equation}
	A_\lambda(p,h) = \sum_d c_d^\lambda A_d(p,h).
	\end{equation}
	For generic spin density matrices, this is easily generalized to
	\begin{equation}
	M^2(p,h,h') = \sum_\lambda A_\lambda(p,h)\, \lambda\, A_\lambda(p,h')^*
	\end{equation}

	To determine the color flow probabilities of a given momentum-helicity
	configuration, the color flow amplitudes are calculated as
	\begin{equation}
	a_f(p,h) = \sum_d \beta^f_d A_d(p,h),
	\end{equation}
	where the coefficients $\beta^f_d$ describe the amplitude for a given
	Feynman diagram (or color graph) $d$ to correspond to a definite color
	flow~$f$. They are computed from $C_{dd'}$ by transforming this
	matrix into the color flow basis and neglecting all off-diagonal
	elements. Again, these coefficients do not depend on momentum or
	helicity and can therefore be calculated in advance. This gives the
	color flow transition matrix
	\begin{equation}
	F^f(p,h,h') = a_f(p,h)\, a^*_f(p,h')
	\end{equation}
	which is assumed diagonal in color flow space and is separate from the
	color-summed transition matrix $M^2$. They are, however, equivalent
	(up to a factor) to leading order in $1/N_c$, and using the color flow
	transition matrix is appropriate for matching to hadronization.

	Note that the color flow transition matrix is not normalized at this
	stage. To make use of it, we have to fold it with the in-state
	density matrix to get a pseudo density matrix
	\begin{equation}
	\hat\rho_{\rm out}^f(p,h_{\rm out},h'_{\rm out})
	= \sum_{h_{\rm in} h'_{\rm in}} F^f(p,h,h')\,
	\rho_{\rm in}(p,h_{\rm in},h'_{\rm in})
	\end{equation}
	which gets a meaning only after contracted with projections on the
	outgoing helicity states $k_{\rm out}$, given as linear combinations
	of helicity states with the unitary coefficient matrix $c(k_{\rm out},
	h_{\rm out})$. Then the probability of finding color flow $f$ when
	the helicity state $k_{\rm out}$ is measured is given by
	\begin{equation}
	P^f(p, k_{\rm out}) = Q^f(p, k_{\rm out}) / \sum_f Q^f(p, k_{\rm out})
	\end{equation}
	where
	\begin{equation}
	Q^f(p, k_{\rm out}) = \sum_{h_{\rm out} h'_{\rm out}}
	c(k_{\rm out}, h_{\rm out})\,
	\hat\rho_{\rm out}^f(p,h_{\rm out},h'_{\rm out})\,
	c^*(k_{\rm out}, h'_{\rm out})
	\end{equation}
	However, if we can assume that the out-state helicity basis is the
	canonical one, we can throw away the off diagonal elements in the
	color flow density matrix and normalize the ones on the diagonal to obtain
	\begin{equation}
	P^f(p, h_{\rm out}) =
	\hat\rho_{\rm out}^f(p,h_{\rm out},h_{\rm out}) /
	\sum_f \hat\rho_{\rm out}^f(p,h_{\rm out},h_{\rm out})
	\end{equation}

	Finally, the color-summed out-state density matrix is computed by the
	scattering formula
	\begin{align}
	{\rho_{\rm out}(p,h_{\rm out},h'_{\rm out})}
	&=
	\sum_{h_{\rm in} h'_{\rm in}} M^2(p,h,h')\,
	\rho_{\rm in}(p,h_{\rm in},h'_{\rm in}) \\
	&= \sum_{h_{\rm in} h'_{\rm in} \lambda}
	A_\lambda(p,h)\, \lambda\, A_\lambda(p,h')^*
	\rho_{\rm in}(p,h_{\rm in},h'_{\rm in}),
	\end{align}
	The trace of $\rho_{\rm out}$ is the squared matrix element, summed
	over all internal degrees of freedom. To get the squared matrix
	element for a definite helicity $k_{\rm out}$ and color flow $f$, one
	has to project the density matrix onto the given helicity state and
	multiply with $P^f(p, k_{\rm out})$.

	For diagonal helicities the out-state density reduces to
	\begin{equation}
	\rho_{\rm out}(p,h_{\rm out})
	= \sum_{h_{\rm in}\lambda}
	\lambda\|A_\lambda(p,h)\|^2 \rho_{\rm in}(p,h_{\rm in}).
	\end{equation}
	Since no basis transformation is involved, we can use the normalized
	color flow probability $P^f(p, h_{\rm out})$ and express the result as
	\begin{align}
	\rho_{\rm out}^f(p,h_{\rm out})
	&= \rho_{\rm out}(p,h_{\rm out})\,P^f(p, h_{\rm out}) \\
	&= \sum_{h_{\rm in}\lambda}
	\frac{\|a^f(p,h)\|^2}{\sum_f\|a^f(p,h)\|^2}
	\lambda\|A_\lambda(p,h)\|^2 \rho_{\rm in}(p,h_{\rm in}).
	\end{align}

	From these considerations, the following calculation strategy can be
	derived:
	\begin{itemize}
	\item
	Before the first event is generated, the color interference matrix
	$C_{dd'}$ is computed and diagonalized, so the eigenvectors
	$c^\lambda_d$, eigenvalues $\lambda$ and color flow coefficients
	$\beta^f_d$ are obtained. In practice, these calculations are
	done when the matrix element code is generated, and the results are
	hardcoded in the matrix element subroutine as [[DATA]] statements.
	\item
	For each event, one loops over helicities once and stores the
	matrices $A_\lambda(p,h)$ and $a^f(p,h)$. The allowed color flows,
	helicity combinations and eigenvalues are each labeled by integer
	indices, so one has to store complex matrices of dimension
	$N_\lambda\times N_h$ and $N_f\times N_h$, respectively.
	\item
	The further strategy depends on the requested information.
	\begin{enumerate}
	\item
	If colorless diagonal helicity amplitudes are required, the
	eigenvalues $A_\lambda(p,h)$ are squared, summed with weight
	$\lambda$, and the result contracted with the in-state probability
	vector $\rho_{\rm in}(p, h_{\rm in})$. The result is a
	probability vector $\rho_{\rm out}(p, h_{\rm out})$.
	\item
	For colored diagonal helicity amplitudes, the color coefficients
	$a^f(p,h)$ are also squared and used as weights to obtain the color-flow
	probability vector $\rho_{\rm out}^f(p, h_{\rm out})$.
	\item
	For colorless non-diagonal helicity amplitudes, we contract the
	tensor product of $A_\lambda(p,h)$ with $A_\lambda(p,h')$,
	weighted with $\lambda$, with the correlated in-state density
	matrix, to obtain a correlated out-state density matrix.
	\item
	In the general (colored, non-diagonal) case, we do the same as
	in the colorless case, but return the un-normalized color flow
	density matrix $\hat\rho_{\rm out}^f(p,h_{\rm out},h'_{\rm out})$
	in addition. When the relevant helicity basis is known, the
	latter can be used by the caller program to determine flow
	probabilities. (In reality, we assume the canonical basis and
	reduce the correlated out-state density to its diagonal immediately.)
	\end{enumerate}
	\end{itemize}
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Flavors: Particle properties}
	This module contains a type for holding the flavor code, and all
	functions that depend on the model, i.e., that determine particle
	properties.

	The PDG code is packed in a special [[flavor]] type. (This prohibits
	meaningless operations, and it allows for a different implementation,
	e.g., some non-PDG scheme internally, if appropiate at some point.)

	There are lots of further particle properties that depend on the
	model. Implementing a flyweight pattern, the associated field data
	object is to be stored in a central area, the [[flavor]] object just
	receives a pointer to this, so all queries can be delegated.
	<<[[flavors.f90]]>>=
	<<File header>>

	module flavors

	<<Use kinds>>
	<<Use strings>>
	use physics_defs, only: UNDEFINED
	use model_data
	use colors, only: color_t

	<<Standard module head>>

	<<Flavors: public>>

	<<Flavors: types>>

	<<Flavors: interfaces>>

	interface
	<<Flavors: sub interfaces>>
	end interface

	end module flavors
	@ %def flavors
	@
	<<[[flavors_sub.f90]]>>=
	<<File header>>

	submodule (flavors) flavors_s

	use io_units
	use diagnostics
	use physics_defs, only: INVALID
	use physics_defs, only: HADRON_REMNANT
	use physics_defs, only: HADRON_REMNANT_SINGLET
	use physics_defs, only: HADRON_REMNANT_TRIPLET
	use physics_defs, only: HADRON_REMNANT_OCTET

	implicit none

	contains

	<<Flavors: procedures>>

	end submodule flavors_s

	@ %def flavors_s
	@
	\subsection{The flavor type}
	The flavor type is an integer representing the PDG code, or
	undefined (zero). Negative codes represent antiflavors. They should
	be used only for particles which do have a distinct antiparticle.

	The [[hard_process]] flag can be set for particles that are participating in
	the hard interaction.

	The [[radiated]] flag can be set for particles that are the result of
	a beam-structure interaction (hadron beam remnant, ISR photon, etc.),
	not of the hard interaction itself.

	Further properties of the given flavor can be retrieved via the
	particle-data pointer, if it is associated.
	<<Flavors: public>>=
	public :: flavor_t
	<<Flavors: types>>=
	type :: flavor_t
	private
	integer :: f = UNDEFINED
	logical :: hard_process = .false.
	logical :: radiated = .false.
	type(field_data_t), pointer :: field_data => null ()
	contains
	<<Flavors: flavor: TBP>>
	end type flavor_t

	@ %def flavor_t
	@ Initializer form. If the model is assigned, the procedure is
	impure, therefore we have to define a separate array version.

	Note: The pure elemental subroutines can't have an intent(out) CLASS
	argument (because of the potential for an impure finalizer in a type
	extension), so we stick to intent(inout) and (re)set all components
	explicitly.
	<<Flavors: flavor: TBP>>=
	generic :: init => &
	flavor_init_empty, &
	flavor_init, &
	flavor_init_field_data, &
	flavor_init_model, &
	flavor_init_model_alt, &
	flavor_init_name_model
	procedure, private :: flavor_init_empty
	procedure, private :: flavor_init
	procedure, private :: flavor_init_field_data
	procedure, private :: flavor_init_model
	procedure, private :: flavor_init_model_alt
	procedure, private :: flavor_init_name_model
	<<Flavors: sub interfaces>>=
	elemental module subroutine flavor_init_empty (flv)
	class(flavor_t), intent(inout) :: flv
	end subroutine flavor_init_empty
	elemental module subroutine flavor_init (flv, f)
	class(flavor_t), intent(inout) :: flv
	integer, intent(in) :: f
	end subroutine flavor_init
	impure elemental module subroutine flavor_init_field_data (flv, field_data)
	class(flavor_t), intent(inout) :: flv
	type(field_data_t), intent(in), target :: field_data
	end subroutine flavor_init_field_data
	impure elemental module subroutine flavor_init_model (flv, f, model)
	class(flavor_t), intent(inout) :: flv
	integer, intent(in) :: f
	class(model_data_t), intent(in), target :: model
	end subroutine flavor_init_model
	impure elemental module subroutine flavor_init_model_alt (flv, f, model, alt_model)
	class(flavor_t), intent(inout) :: flv
	integer, intent(in) :: f
	class(model_data_t), intent(in), target :: model, alt_model
	end subroutine flavor_init_model_alt
	impure elemental module subroutine flavor_init_name_model (flv, name, model)
	class(flavor_t), intent(inout) :: flv
	type(string_t), intent(in) :: name
	class(model_data_t), intent(in), target :: model
	end subroutine flavor_init_name_model
	<<Flavors: procedures>>=
	elemental module subroutine flavor_init_empty (flv)
	class(flavor_t), intent(inout) :: flv
	flv%f = UNDEFINED
	flv%hard_process = .false.
	flv%radiated = .false.
	flv%field_data => null ()
	end subroutine flavor_init_empty

	elemental module subroutine flavor_init (flv, f)
	class(flavor_t), intent(inout) :: flv
	integer, intent(in) :: f
	flv%f = f
	flv%hard_process = .false.
	flv%radiated = .false.
	flv%field_data => null ()
	end subroutine flavor_init

	impure elemental module subroutine flavor_init_field_data (flv, field_data)
	class(flavor_t), intent(inout) :: flv
	type(field_data_t), intent(in), target :: field_data
	flv%f = field_data%get_pdg ()
	flv%hard_process = .false.
	flv%radiated = .false.
	flv%field_data => field_data
	end subroutine flavor_init_field_data

	impure elemental module subroutine flavor_init_model (flv, f, model)
	class(flavor_t), intent(inout) :: flv
	integer, intent(in) :: f
	class(model_data_t), intent(in), target :: model
	flv%f = f
	flv%hard_process = .false.
	flv%radiated = .false.
	flv%field_data => model%get_field_ptr (f, check=.true.)
	end subroutine flavor_init_model

	impure elemental module subroutine flavor_init_model_alt (flv, f, model, alt_model)
	class(flavor_t), intent(inout) :: flv
	integer, intent(in) :: f
	class(model_data_t), intent(in), target :: model, alt_model
	flv%f = f
	flv%hard_process = .false.
	flv%radiated = .false.
	flv%field_data => model%get_field_ptr (f, check=.false.)
	if (.not. associated (flv%field_data)) then
	flv%field_data => alt_model%get_field_ptr (f, check=.false.)
	if (.not. associated (flv%field_data)) then
	write (msg_buffer, "(A,1x,I0,1x,A,1x,A,1x,A,1x,A)") &
	"Particle with code", f, &
	"found neither in model", char (model%get_name ()), &
	"nor in model", char (alt_model%get_name ())
	call msg_fatal ()
	end if
	end if
	end subroutine flavor_init_model_alt

	impure elemental module subroutine flavor_init_name_model (flv, name, model)
	class(flavor_t), intent(inout) :: flv
	type(string_t), intent(in) :: name
	class(model_data_t), intent(in), target :: model
	flv%f = model%get_pdg (name)
	flv%hard_process = .false.
	flv%radiated = .false.
	flv%field_data => model%get_field_ptr (name, check=.true.)
	end subroutine flavor_init_name_model

	@ %def flavor_init
	@ Set the [[radiated]] flag.
	<<Flavors: flavor: TBP>>=
	procedure :: tag_radiated => flavor_tag_radiated
	<<Flavors: sub interfaces>>=
	elemental module subroutine flavor_tag_radiated (flv)
	class(flavor_t), intent(inout) :: flv
	end subroutine flavor_tag_radiated
	<<Flavors: procedures>>=
	elemental module subroutine flavor_tag_radiated (flv)
	class(flavor_t), intent(inout) :: flv
	flv%radiated = .true.
	end subroutine flavor_tag_radiated

	@ %def flavor_tag_radiated
	@ Set the [[hard_process]] flag.
	<<Flavors: flavor: TBP>>=
	procedure :: tag_hard_process => flavor_tag_hard_process
	<<Flavors: sub interfaces>>=
	elemental module subroutine flavor_tag_hard_process (flv, hard)
	class(flavor_t), intent(inout) :: flv
	logical, intent(in), optional :: hard
	end subroutine flavor_tag_hard_process
	<<Flavors: procedures>>=
	elemental module subroutine flavor_tag_hard_process (flv, hard)
	class(flavor_t), intent(inout) :: flv
	logical, intent(in), optional :: hard
	if (present (hard)) then
	flv%hard_process = hard
	else
	flv%hard_process = .true.
	end if
	end subroutine flavor_tag_hard_process

	@ %def flavor_tag_hard_process
	@ Undefine the flavor state:
	<<Flavors: flavor: TBP>>=
	procedure :: undefine => flavor_undefine
	<<Flavors: sub interfaces>>=
	elemental module subroutine flavor_undefine (flv)
	class(flavor_t), intent(inout) :: flv
	end subroutine flavor_undefine
	<<Flavors: procedures>>=
	elemental module subroutine flavor_undefine (flv)
	class(flavor_t), intent(inout) :: flv
	flv%f = UNDEFINED
	flv%field_data => null ()
	end subroutine flavor_undefine

	@ %def flavor_undefine
	@ Output: dense, no linebreak

	A hard-process tag is only shown if debugging is on.
	<<Flavors: flavor: TBP>>=
	procedure :: write => flavor_write
	<<Flavors: sub interfaces>>=
	module subroutine flavor_write (flv, unit)
	class(flavor_t), intent(in) :: flv
	integer, intent(in), optional :: unit
	end subroutine flavor_write
	<<Flavors: procedures>>=
	module subroutine flavor_write (flv, unit)
	class(flavor_t), intent(in) :: flv
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	if (associated (flv%field_data)) then
	write (u, "(A)", advance="no") "f("
	else
	write (u, "(A)", advance="no") "p("
	end if
	write (u, "(I0)", advance="no") flv%f
	if (flv%radiated) then
	write (u, "('*')", advance="no")
	end if
	if (msg_level (D_FLAVOR) >= DEBUG) then
	if (flv%hard_process) then
	write (u, "('#')", advance="no")
	end if
	end if
	write (u, "(A)", advance="no") ")"
	end subroutine flavor_write

	@ %def flavor_write
	@
	<<Flavors: public>>=
	public :: flavor_write_array
	<<Flavors: sub interfaces>>=
	module subroutine flavor_write_array (flv, unit)
	type(flavor_t), intent(in), dimension(:) :: flv
	integer, intent(in), optional :: unit
	end subroutine flavor_write_array
	<<Flavors: procedures>>=
	module subroutine flavor_write_array (flv, unit)
	type(flavor_t), intent(in), dimension(:) :: flv
	integer, intent(in), optional :: unit
	integer :: u, i_flv
	u = given_output_unit (unit); if (u < 0) return
	do i_flv = 1, size (flv)
	call flv(i_flv)%write (u)
	if (i_flv /= size (flv)) write (u,"(A)", advance = "no") " / "
	end do
	write (u,"(A)")
	end subroutine flavor_write_array

	@ %def flavor_write_array
	@ Binary I/O. Currently, the model information is not written/read,
	so after reading the particle-data pointer is empty.
	<<Flavors: flavor: TBP>>=
	procedure :: write_raw => flavor_write_raw
	procedure :: read_raw => flavor_read_raw
	<<Flavors: sub interfaces>>=
	module subroutine flavor_write_raw (flv, u)
	class(flavor_t), intent(in) :: flv
	integer, intent(in) :: u
	end subroutine flavor_write_raw
	module subroutine flavor_read_raw (flv, u, iostat)
	class(flavor_t), intent(out) :: flv
	integer, intent(in) :: u
	integer, intent(out), optional :: iostat
	end subroutine flavor_read_raw
	<<Flavors: procedures>>=
	module subroutine flavor_write_raw (flv, u)
	class(flavor_t), intent(in) :: flv
	integer, intent(in) :: u
	write (u) flv%f
	write (u) flv%radiated
	write (u) flv%hard_process
	end subroutine flavor_write_raw

	module subroutine flavor_read_raw (flv, u, iostat)
	class(flavor_t), intent(out) :: flv
	integer, intent(in) :: u
	integer, intent(out), optional :: iostat
	read (u, iostat=iostat) flv%f
	if (present (iostat)) then
	if (iostat /= 0) return
	end if
	read (u, iostat=iostat) flv%radiated
	read (u, iostat=iostat) flv%hard_process
	end subroutine flavor_read_raw

	@ %def flavor_write_raw flavor_read_raw
	@
	\subsubsection{Assignment}
	Default assignment of flavor objects is possible, but cannot be used
	in pure procedures, because a pointer assignment is involved.

	Assign the particle pointer separately. This cannot be elemental, so
	we define a scalar and an array version explicitly. We refer to an
	array of flavors, not an array of models.
	<<Flavors: flavor: TBP>>=
	procedure :: set_model => flavor_set_model_single
	<<Flavors: sub interfaces>>=
	impure elemental module subroutine flavor_set_model_single (flv, model)
	class(flavor_t), intent(inout) :: flv
	class(model_data_t), intent(in), target :: model
	end subroutine flavor_set_model_single
	<<Flavors: procedures>>=
	impure elemental module subroutine flavor_set_model_single (flv, model)
	class(flavor_t), intent(inout) :: flv
	class(model_data_t), intent(in), target :: model
	if (flv%f /= UNDEFINED) &
	flv%field_data => model%get_field_ptr (flv%f)
	end subroutine flavor_set_model_single

	@ %def flavor_set_model
	@
	\subsubsection{Predicates}
	Return the definition status. By definition, the flavor object is
	defined if the flavor PDG code is nonzero.
	<<Flavors: flavor: TBP>>=
	procedure :: is_defined => flavor_is_defined
	<<Flavors: sub interfaces>>=
	elemental module function flavor_is_defined (flv) result (defined)
	class(flavor_t), intent(in) :: flv
	logical :: defined
	end function flavor_is_defined
	<<Flavors: procedures>>=
	elemental module function flavor_is_defined (flv) result (defined)
	class(flavor_t), intent(in) :: flv
	logical :: defined
	defined = flv%f /= UNDEFINED
	end function flavor_is_defined

	@ %def flavor_is_defined
	@ Check for valid flavor (including undefined). This is distinct from
	the [[is_defined]] status. Invalid flavor is actually a specific PDG
	code.
	<<Flavors: flavor: TBP>>=
	procedure :: is_valid => flavor_is_valid
	<<Flavors: sub interfaces>>=
	elemental module function flavor_is_valid (flv) result (valid)
	class(flavor_t), intent(in) :: flv
	logical :: valid
	end function flavor_is_valid
	<<Flavors: procedures>>=
	elemental module function flavor_is_valid (flv) result (valid)
	class(flavor_t), intent(in) :: flv
	logical :: valid
	valid = flv%f /= INVALID
	end function flavor_is_valid

	@ %def flavor_is_valid
	@ Return true if the particle-data pointer is associated. (Debugging aid)
	<<Flavors: flavor: TBP>>=
	procedure :: is_associated => flavor_is_associated
	<<Flavors: sub interfaces>>=
	elemental module function flavor_is_associated (flv) result (flag)
	class(flavor_t), intent(in) :: flv
	logical :: flag
	end function flavor_is_associated
	<<Flavors: procedures>>=
	elemental module function flavor_is_associated (flv) result (flag)
	class(flavor_t), intent(in) :: flv
	logical :: flag
	flag = associated (flv%field_data)
	end function flavor_is_associated

	@ %def flavor_is_associated
	@ Check the [[radiated]] flag. A radiated particle has a definite PDG
	flavor status, but it is actually a pseudoparticle (a beam remnant)
	which may be subject to fragmentation.
	<<Flavors: flavor: TBP>>=
	procedure :: is_radiated => flavor_is_radiated
	<<Flavors: sub interfaces>>=
	elemental module function flavor_is_radiated (flv) result (flag)
	class(flavor_t), intent(in) :: flv
	logical :: flag
	end function flavor_is_radiated
	<<Flavors: procedures>>=
	elemental module function flavor_is_radiated (flv) result (flag)
	class(flavor_t), intent(in) :: flv
	logical :: flag
	flag = flv%radiated
	end function flavor_is_radiated

	@ %def flavor_is_radiated
	@ Check the [[hard_process]] flag. A particle is tagged with this flag if
	it participates in the hard interaction and is not a beam remnant.
	<<Flavors: flavor: TBP>>=
	procedure :: is_hard_process => flavor_is_hard_process
	<<Flavors: sub interfaces>>=
	elemental module function flavor_is_hard_process (flv) result (flag)
	class(flavor_t), intent(in) :: flv
	logical :: flag
	end function flavor_is_hard_process
	<<Flavors: procedures>>=
	elemental module function flavor_is_hard_process (flv) result (flag)
	class(flavor_t), intent(in) :: flv
	logical :: flag
	flag = flv%hard_process
	end function flavor_is_hard_process

	@ %def flavor_is_hard_process
	@
	\subsubsection{Accessing contents}
	With the exception of the PDG code, all particle property enquiries are
	delegated to the [[field_data]] pointer. If this is unassigned, some
	access function will crash.

	Return the flavor as an integer
	<<Flavors: flavor: TBP>>=
	procedure :: get_pdg => flavor_get_pdg
	<<Flavors: sub interfaces>>=
	elemental module function flavor_get_pdg (flv) result (f)
	integer :: f
	class(flavor_t), intent(in) :: flv
	end function flavor_get_pdg
	<<Flavors: procedures>>=
	elemental module function flavor_get_pdg (flv) result (f)
	integer :: f
	class(flavor_t), intent(in) :: flv
	f = flv%f
	end function flavor_get_pdg

	@ %def flavor_get_pdg
	@ Return the flavor of the antiparticle
	<<Flavors: flavor: TBP>>=
	procedure :: get_pdg_anti => flavor_get_pdg_anti
	<<Flavors: sub interfaces>>=
	elemental module function flavor_get_pdg_anti (flv) result (f)
	integer :: f
	class(flavor_t), intent(in) :: flv
	end function flavor_get_pdg_anti
	<<Flavors: procedures>>=
	elemental module function flavor_get_pdg_anti (flv) result (f)
	integer :: f
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	if (flv%field_data%has_antiparticle ()) then
	f = -flv%f
	else
	f = flv%f
	end if
	else
	f = 0
	end if
	end function flavor_get_pdg_anti

	@ %def flavor_get_pdg_anti
	@
	Absolute value:
	<<Flavors: flavor: TBP>>=
	procedure :: get_pdg_abs => flavor_get_pdg_abs
	<<Flavors: sub interfaces>>=
	elemental module function flavor_get_pdg_abs (flv) result (f)
	integer :: f
	class(flavor_t), intent(in) :: flv
	end function flavor_get_pdg_abs
	<<Flavors: procedures>>=
	elemental module function flavor_get_pdg_abs (flv) result (f)
	integer :: f
	class(flavor_t), intent(in) :: flv
	f = abs (flv%f)
	end function flavor_get_pdg_abs

	@ %def flavor_get_pdg_abs
	@
	Generic properties
	<<Flavors: flavor: TBP>>=
	procedure :: is_visible => flavor_is_visible
	procedure :: is_parton => flavor_is_parton
	procedure :: is_beam_remnant => flavor_is_beam_remnant
	procedure :: is_gauge => flavor_is_gauge
	procedure :: is_left_handed => flavor_is_left_handed
	procedure :: is_right_handed => flavor_is_right_handed
	procedure :: is_antiparticle => flavor_is_antiparticle
	procedure :: has_antiparticle => flavor_has_antiparticle
	procedure :: is_stable => flavor_is_stable
	+ procedure :: width_is_input => flavor_width_is_input
	+ procedure :: mass_is_input => flavor_mass_is_input
	procedure :: get_decays => flavor_get_decays
	procedure :: decays_isotropically => flavor_decays_isotropically
	procedure :: decays_diagonal => flavor_decays_diagonal
	procedure :: has_decay_helicity => flavor_has_decay_helicity
	procedure :: get_decay_helicity => flavor_get_decay_helicity
	procedure :: is_polarized => flavor_is_polarized
	<<Flavors: sub interfaces>>=
	elemental module function flavor_is_visible (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_is_visible
	elemental module function flavor_is_parton (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_is_parton
	elemental module function flavor_is_beam_remnant (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_is_beam_remnant
	elemental module function flavor_is_gauge (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_is_gauge
	elemental module function flavor_is_left_handed (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_is_left_handed
	elemental module function flavor_is_right_handed (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_is_right_handed
	elemental module function flavor_is_antiparticle (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_is_antiparticle
	elemental module function flavor_has_antiparticle (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_has_antiparticle
	elemental module function flavor_is_stable (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_is_stable
	+ elemental module function flavor_width_is_input (flv) result (flag)
	+ logical :: flag
	+ class(flavor_t), intent(in) :: flv
	+ end function flavor_width_is_input
	+ elemental module function flavor_mass_is_input (flv) result (flag)
	+ logical :: flag
	+ class(flavor_t), intent(in) :: flv
	+ end function flavor_mass_is_input
	module subroutine flavor_get_decays (flv, decay)
	class(flavor_t), intent(in) :: flv
	type(string_t), dimension(:), intent(out), allocatable :: decay
	logical :: anti
	end subroutine flavor_get_decays
	elemental module function flavor_decays_isotropically (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_decays_isotropically
	elemental module function flavor_decays_diagonal (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_decays_diagonal
	elemental module function flavor_has_decay_helicity (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_has_decay_helicity
	elemental module function flavor_get_decay_helicity (flv) result (hel)
	integer :: hel
	class(flavor_t), intent(in) :: flv
	end function flavor_get_decay_helicity
	elemental module function flavor_is_polarized (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	end function flavor_is_polarized
	<<Flavors: procedures>>=
	elemental module function flavor_is_visible (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	flag = flv%field_data%is_visible ()
	else
	flag = .false.
	end if
	end function flavor_is_visible

	elemental module function flavor_is_parton (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	flag = flv%field_data%is_parton ()
	else
	flag = .false.
	end if
	end function flavor_is_parton

	elemental module function flavor_is_beam_remnant (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	select case (abs (flv%f))
	case (HADRON_REMNANT, &
	HADRON_REMNANT_SINGLET, HADRON_REMNANT_TRIPLET, HADRON_REMNANT_OCTET)
	flag = .true.
	case default
	flag = .false.
	end select
	end function flavor_is_beam_remnant

	elemental module function flavor_is_gauge (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	flag = flv%field_data%is_gauge ()
	else
	flag = .false.
	end if
	end function flavor_is_gauge

	elemental module function flavor_is_left_handed (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	if (flv%f > 0) then
	flag = flv%field_data%is_left_handed ()
	else
	flag = flv%field_data%is_right_handed ()
	end if
	else
	flag = .false.
	end if
	end function flavor_is_left_handed

	elemental module function flavor_is_right_handed (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	if (flv%f > 0) then
	flag = flv%field_data%is_right_handed ()
	else
	flag = flv%field_data%is_left_handed ()
	end if
	else
	flag = .false.
	end if
	end function flavor_is_right_handed

	elemental module function flavor_is_antiparticle (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	flag = flv%f < 0
	end function flavor_is_antiparticle

	elemental module function flavor_has_antiparticle (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	flag = flv%field_data%has_antiparticle ()
	else
	flag = .false.
	end if
	end function flavor_has_antiparticle

	elemental module function flavor_is_stable (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	flag = flv%field_data%is_stable (anti = flv%f < 0)
	else
	flag = .true.
	end if
	end function flavor_is_stable

	+ elemental module function flavor_width_is_input (flv) result (flag)
	+ logical :: flag
	+ class(flavor_t), intent(in) :: flv
	+ flag = flv%field_data%width_is_input ()
	+ end function flavor_width_is_input
	+
	+ elemental module function flavor_mass_is_input (flv) result (flag)
	+ logical :: flag
	+ class(flavor_t), intent(in) :: flv
	+ flag = flv%field_data%mass_is_input ()
	+ end function flavor_mass_is_input
	+
	module subroutine flavor_get_decays (flv, decay)
	class(flavor_t), intent(in) :: flv
	type(string_t), dimension(:), intent(out), allocatable :: decay
	logical :: anti
	anti = flv%f < 0
	if (.not. flv%field_data%is_stable (anti)) then
	call flv%field_data%get_decays (decay, anti)
	end if
	end subroutine flavor_get_decays

	elemental module function flavor_decays_isotropically (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	flag = flv%field_data%decays_isotropically (anti = flv%f < 0)
	else
	flag = .true.
	end if
	end function flavor_decays_isotropically

	elemental module function flavor_decays_diagonal (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	flag = flv%field_data%decays_diagonal (anti = flv%f < 0)
	else
	flag = .true.
	end if
	end function flavor_decays_diagonal

	elemental module function flavor_has_decay_helicity (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	flag = flv%field_data%has_decay_helicity (anti = flv%f < 0)
	else
	flag = .false.
	end if
	end function flavor_has_decay_helicity

	elemental module function flavor_get_decay_helicity (flv) result (hel)
	integer :: hel
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	hel = flv%field_data%decay_helicity (anti = flv%f < 0)
	else
	hel = 0
	end if
	end function flavor_get_decay_helicity

	elemental module function flavor_is_polarized (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	flag = flv%field_data%is_polarized (anti = flv%f < 0)
	else
	flag = .false.
	end if
	end function flavor_is_polarized

	@ %def flavor_is_visible
	@ %def flavor_is_parton
	@ %def flavor_is_beam_remnant
	@ %def flavor_is_gauge
	@ %def flavor_is_left_handed
	@ %def flavor_is_right_handed
	@ %def flavor_is_antiparticle
	@ %def flavor_has_antiparticle
	@ %def flavor_is_stable
	+@ %def flavor_width_is_input
	+@ %def flavor_mass_is_input
	@ %def flavor_get_decays
	@ %def flavor_decays_isotropically
	@ %def flavor_decays_diagonal
	@ %def flavor_has_decays_helicity
	@ %def flavor_get_decay_helicity
	@ %def flavor_is_polarized
	@ Names:
	<<Flavors: flavor: TBP>>=
	procedure :: get_name => flavor_get_name
	procedure :: get_tex_name => flavor_get_tex_name
	<<Flavors: sub interfaces>>=
	elemental module function flavor_get_name (flv) result (name)
	type(string_t) :: name
	class(flavor_t), intent(in) :: flv
	end function flavor_get_name
	elemental module function flavor_get_tex_name (flv) result (name)
	type(string_t) :: name
	class(flavor_t), intent(in) :: flv
	end function flavor_get_tex_name
	<<Flavors: procedures>>=
	elemental module function flavor_get_name (flv) result (name)
	type(string_t) :: name
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	name = flv%field_data%get_name (flv%f < 0)
	else
	name = "?"
	end if
	end function flavor_get_name

	elemental module function flavor_get_tex_name (flv) result (name)
	type(string_t) :: name
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	name = flv%field_data%get_tex_name (flv%f < 0)
	else
	name = "?"
	end if
	end function flavor_get_tex_name

	@ %def flavor_get_name flavor_get_tex_name
	<<Flavors: flavor: TBP>>=
	procedure :: get_spin_type => flavor_get_spin_type
	procedure :: get_multiplicity => flavor_get_multiplicity
	procedure :: get_isospin_type => flavor_get_isospin_type
	procedure :: get_charge_type => flavor_get_charge_type
	procedure :: get_color_type => flavor_get_color_type
	<<Flavors: sub interfaces>>=
	elemental module function flavor_get_spin_type (flv) result (type)
	integer :: type
	class(flavor_t), intent(in) :: flv
	end function flavor_get_spin_type
	elemental module function flavor_get_multiplicity (flv) result (type)
	integer :: type
	class(flavor_t), intent(in) :: flv
	end function flavor_get_multiplicity
	elemental module function flavor_get_isospin_type (flv) result (type)
	integer :: type
	class(flavor_t), intent(in) :: flv
	end function flavor_get_isospin_type
	elemental module function flavor_get_charge_type (flv) result (type)
	integer :: type
	class(flavor_t), intent(in) :: flv
	end function flavor_get_charge_type
	elemental module function flavor_get_color_type (flv) result (type)
	integer :: type
	class(flavor_t), intent(in) :: flv
	end function flavor_get_color_type
	<<Flavors: procedures>>=
	elemental module function flavor_get_spin_type (flv) result (type)
	integer :: type
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	type = flv%field_data%get_spin_type ()
	else
	type = 1
	end if
	end function flavor_get_spin_type

	elemental module function flavor_get_multiplicity (flv) result (type)
	integer :: type
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	type = flv%field_data%get_multiplicity ()
	else
	type = 1
	end if
	end function flavor_get_multiplicity

	elemental module function flavor_get_isospin_type (flv) result (type)
	integer :: type
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	type = flv%field_data%get_isospin_type ()
	else
	type = 1
	end if
	end function flavor_get_isospin_type

	elemental module function flavor_get_charge_type (flv) result (type)
	integer :: type
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	type = flv%field_data%get_charge_type ()
	else
	type = 1
	end if
	end function flavor_get_charge_type

	elemental module function flavor_get_color_type (flv) result (type)
	integer :: type
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	if (flavor_is_antiparticle (flv)) then
	type = - flv%field_data%get_color_type ()
	else
	type = flv%field_data%get_color_type ()
	end if
	select case (type)
	case (-1,-8); type = abs (type)
	end select
	else
	type = 1
	end if
	end function flavor_get_color_type

	@ %def flavor_get_spin_type
	@ %def flavor_get_multiplicity
	@ %def flavor_get_isospin_type
	@ %def flavor_get_charge_type
	@ %def flavor_get_color_type
	@ These functions return real values:
	<<Flavors: flavor: TBP>>=
	procedure :: get_charge => flavor_get_charge
	procedure :: get_mass => flavor_get_mass
	procedure :: get_width => flavor_get_width
	procedure :: get_isospin => flavor_get_isospin
	<<Flavors: sub interfaces>>=
	elemental module function flavor_get_charge (flv) result (charge)
	real(default) :: charge
	class(flavor_t), intent(in) :: flv
	end function flavor_get_charge
	elemental module function flavor_get_mass (flv) result (mass)
	real(default) :: mass
	class(flavor_t), intent(in) :: flv
	end function flavor_get_mass
	elemental module function flavor_get_width (flv) result (width)
	real(default) :: width
	class(flavor_t), intent(in) :: flv
	end function flavor_get_width
	elemental module function flavor_get_isospin (flv) result (isospin)
	real(default) :: isospin
	class(flavor_t), intent(in) :: flv
	end function flavor_get_isospin
	<<Flavors: procedures>>=
	elemental module function flavor_get_charge (flv) result (charge)
	real(default) :: charge
	class(flavor_t), intent(in) :: flv
	integer :: charge_type
	if (associated (flv%field_data)) then
	charge_type = flv%get_charge_type ()
	if (charge_type == 0 .or. charge_type == 1) then
	charge = 0
	else
	if (flavor_is_antiparticle (flv)) then
	charge = - flv%field_data%get_charge ()
	else
	charge = flv%field_data%get_charge ()
	end if
	end if
	else
	charge = 0
	end if
	end function flavor_get_charge

	elemental module function flavor_get_mass (flv) result (mass)
	real(default) :: mass
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	mass = flv%field_data%get_mass ()
	else
	mass = 0
	end if
	end function flavor_get_mass

	elemental module function flavor_get_width (flv) result (width)
	real(default) :: width
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	width = flv%field_data%get_width ()
	else
	width = 0
	end if
	end function flavor_get_width

	elemental module function flavor_get_isospin (flv) result (isospin)
	real(default) :: isospin
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	if (flavor_is_antiparticle (flv)) then
	isospin = - flv%field_data%get_isospin ()
	else
	isospin = flv%field_data%get_isospin ()
	end if
	else
	isospin = 0
	end if
	end function flavor_get_isospin

	@ %def flavor_get_charge flavor_get_mass flavor_get_width
	@ %def flavor_get_isospin
	@
	\subsubsection{Comparisons}
	If one of the flavors is undefined, the other defined, they match.
	<<Flavors: flavor: TBP>>=
	generic :: operator(.match.) => flavor_match
	generic :: operator(==) => flavor_eq
	generic :: operator(/=) => flavor_neq
	procedure, private :: flavor_match
	procedure, private :: flavor_eq
	procedure, private :: flavor_neq
	@ %def .match. == /=
	<<Flavors: sub interfaces>>=
	elemental module function flavor_match (flv1, flv2) result (eq)
	logical :: eq
	class(flavor_t), intent(in) :: flv1, flv2
	end function flavor_match
	elemental module function flavor_eq (flv1, flv2) result (eq)
	logical :: eq
	class(flavor_t), intent(in) :: flv1, flv2
	end function flavor_eq
	<<Flavors: procedures>>=
	elemental module function flavor_match (flv1, flv2) result (eq)
	logical :: eq
	class(flavor_t), intent(in) :: flv1, flv2
	if (flv1%f /= UNDEFINED .and. flv2%f /= UNDEFINED) then
	eq = flv1%f == flv2%f
	else
	eq = .true.
	end if
	end function flavor_match

	elemental module function flavor_eq (flv1, flv2) result (eq)
	logical :: eq
	class(flavor_t), intent(in) :: flv1, flv2
	if (flv1%f /= UNDEFINED .and. flv2%f /= UNDEFINED) then
	eq = flv1%f == flv2%f
	else if (flv1%f == UNDEFINED .and. flv2%f == UNDEFINED) then
	eq = .true.
	else
	eq = .false.
	end if
	end function flavor_eq

	@ %def flavor_match flavor_eq
	<<Flavors: sub interfaces>>=
	elemental module function flavor_neq (flv1, flv2) result (neq)
	logical :: neq
	class(flavor_t), intent(in) :: flv1, flv2
	end function flavor_neq
	<<Flavors: procedures>>=
	elemental module function flavor_neq (flv1, flv2) result (neq)
	logical :: neq
	class(flavor_t), intent(in) :: flv1, flv2
	if (flv1%f /= UNDEFINED .and. flv2%f /= UNDEFINED) then
	neq = flv1%f /= flv2%f
	else if (flv1%f == UNDEFINED .and. flv2%f == UNDEFINED) then
	neq = .false.
	else
	neq = .true.
	end if
	end function flavor_neq

	@ %def flavor_neq
	@
	\subsubsection{Tools}
	Merge two flavor indices. This works only if both are equal or either
	one is undefined, because we have no off-diagonal flavor entries.
	Otherwise, generate an invalid flavor.

	We cannot use elemental procedures because of the pointer component.
	<<Flavors: public>>=
	public :: operator(.merge.)
	<<Flavors: interfaces>>=
	interface operator(.merge.)
	module procedure merge_flavors0
	module procedure merge_flavors1
	end interface

	@ %def .merge.
	<<Flavors: sub interfaces>>=
	module function merge_flavors0 (flv1, flv2) result (flv)
	type(flavor_t) :: flv
	type(flavor_t), intent(in) :: flv1, flv2
	end function merge_flavors0
	module function merge_flavors1 (flv1, flv2) result (flv)
	type(flavor_t), dimension(:), intent(in) :: flv1, flv2
	type(flavor_t), dimension(size(flv1)) :: flv
	end function merge_flavors1
	<<Flavors: procedures>>=
	module function merge_flavors0 (flv1, flv2) result (flv)
	type(flavor_t) :: flv
	type(flavor_t), intent(in) :: flv1, flv2
	if (flavor_is_defined (flv1) .and. flavor_is_defined (flv2)) then
	if (flv1 == flv2) then
	flv = flv1
	else
	flv%f = INVALID
	end if
	else if (flavor_is_defined (flv1)) then
	flv = flv1
	else if (flavor_is_defined (flv2)) then
	flv = flv2
	end if
	end function merge_flavors0

	module function merge_flavors1 (flv1, flv2) result (flv)
	type(flavor_t), dimension(:), intent(in) :: flv1, flv2
	type(flavor_t), dimension(size(flv1)) :: flv
	integer :: i
	do i = 1, size (flv1)
	flv(i) = flv1(i) .merge. flv2(i)
	end do
	end function merge_flavors1

	@ %def merge_flavors
	@ Generate consecutive color indices for a given flavor. The indices
	are counted starting with the stored value of c, so new indices are
	created each time this (impure) function is called. The counter can
	be reset by the optional argument [[c_seed]] if desired. The optional
	flag [[reverse]] is used only for octets. If set, the color and
	anticolor entries of the octet particle are exchanged.
	<<Flavors: public>>=
	public :: color_from_flavor
	<<Flavors: interfaces>>=
	interface color_from_flavor
	module procedure color_from_flavor0
	module procedure color_from_flavor1
	end interface
	<<Flavors: sub interfaces>>=
	module function color_from_flavor0 (flv, c_seed, reverse) result (col)
	type(color_t) :: col
	type(flavor_t), intent(in) :: flv
	integer, intent(in), optional :: c_seed
	logical, intent(in), optional :: reverse
	end function color_from_flavor0
	module function color_from_flavor1 (flv, c_seed, reverse) result (col)
	type(flavor_t), dimension(:), intent(in) :: flv
	integer, intent(in), optional :: c_seed
	logical, intent(in), optional :: reverse
	type(color_t), dimension(size(flv)) :: col
	end function color_from_flavor1
	<<Flavors: procedures>>=
	module function color_from_flavor0 (flv, c_seed, reverse) result (col)
	type(color_t) :: col
	type(flavor_t), intent(in) :: flv
	integer, intent(in), optional :: c_seed
	logical, intent(in), optional :: reverse
	integer, save :: c = 1
	logical :: rev
	if (present (c_seed)) c = c_seed
	rev = .false.; if (present (reverse)) rev = reverse
	select case (flavor_get_color_type (flv))
	case (1)
	call col%init ()
	case (3)
	call col%init ([c]); c = c + 1
	case (-3)
	call col%init ([-c]); c = c + 1
	case (8)
	if (rev) then
	call col%init ([c+1, -c]); c = c + 2
	else
	call col%init ([c, -(c+1)]); c = c + 2
	end if
	end select
	end function color_from_flavor0

	module function color_from_flavor1 (flv, c_seed, reverse) result (col)
	type(flavor_t), dimension(:), intent(in) :: flv
	integer, intent(in), optional :: c_seed
	logical, intent(in), optional :: reverse
	type(color_t), dimension(size(flv)) :: col
	integer :: i
	col(1) = color_from_flavor0 (flv(1), c_seed, reverse)
	do i = 2, size (flv)
	col(i) = color_from_flavor0 (flv(i), reverse=reverse)
	end do
	end function color_from_flavor1

	@ %def color_from_flavor
	@ This procedure returns the flavor object for the antiparticle. The
	antiparticle code may either be the same code or its negative.
	<<Flavors: flavor: TBP>>=
	procedure :: anti => flavor_anti
	<<Flavors: sub interfaces>>=
	module function flavor_anti (flv) result (aflv)
	type(flavor_t) :: aflv
	class(flavor_t), intent(in) :: flv
	end function flavor_anti
	<<Flavors: procedures>>=
	module function flavor_anti (flv) result (aflv)
	type(flavor_t) :: aflv
	class(flavor_t), intent(in) :: flv
	if (flavor_has_antiparticle (flv)) then
	aflv%f = - flv%f
	else
	aflv%f = flv%f
	end if
	aflv%field_data => flv%field_data
	end function flavor_anti

	@ %def flavor_anti
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Quantum numbers}
	This module collects helicity, color, and flavor in a single type and
	defines procedures
	<<[[quantum_numbers.f90]]>>=
	<<File header>>

	module quantum_numbers

	use model_data
	use helicities
	use colors
	use flavors

	<<Standard module head>>

	<<Quantum numbers: public>>

	<<Quantum numbers: types>>

	<<Quantum numbers: interfaces>>

	interface
	<<Quantum numbers: sub interfaces>>
	end interface

	end module quantum_numbers
	@ %def quantum_numbers
	@
	<<[[quantum_numbers_sub.f90]]>>=
	<<File header>>

	submodule (quantum_numbers) quantum_numbers_s

	use io_units

	implicit none

	contains

	<<Quantum numbers: procedures>>

	end submodule quantum_numbers_s

	@ %def quantum_numbers_s
	@
	\subsection{The quantum number type}
	<<Quantum numbers: public>>=
	public :: quantum_numbers_t
	<<Quantum numbers: types>>=
	type :: quantum_numbers_t
	private
	type(flavor_t) :: f
	type(color_t) :: c
	type(helicity_t) :: h
	integer :: sub = 0
	contains
	<<Quantum numbers: quantum numbers: TBP>>
	end type quantum_numbers_t

	@ %def quantum_number_t
	@ Define quantum numbers: Initializer form. All arguments may be
	present or absent.

	Some elemental initializers are impure because they set the [[flv]]
	component. This implies transfer of a pointer behind the scenes.
	<<Quantum numbers: quantum numbers: TBP>>=
	generic :: init => &
	quantum_numbers_init_f, &
	quantum_numbers_init_c, &
	quantum_numbers_init_h, &
	quantum_numbers_init_fc, &
	quantum_numbers_init_fh, &
	quantum_numbers_init_ch, &
	quantum_numbers_init_fch, &
	quantum_numbers_init_fs, &
	quantum_numbers_init_fhs, &
	quantum_numbers_init_fcs, &
	quantum_numbers_init_fhcs
	procedure, private :: quantum_numbers_init_f
	procedure, private :: quantum_numbers_init_c
	procedure, private :: quantum_numbers_init_h
	procedure, private :: quantum_numbers_init_fc
	procedure, private :: quantum_numbers_init_fh
	procedure, private :: quantum_numbers_init_ch
	procedure, private :: quantum_numbers_init_fch
	procedure, private :: quantum_numbers_init_fs
	procedure, private :: quantum_numbers_init_fhs
	procedure, private :: quantum_numbers_init_fcs
	procedure, private :: quantum_numbers_init_fhcs
	<<Quantum numbers: sub interfaces>>=
	impure elemental module subroutine quantum_numbers_init_f (qn, flv)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	end subroutine quantum_numbers_init_f
	impure elemental module subroutine quantum_numbers_init_c (qn, col)
	class(quantum_numbers_t), intent(out) :: qn
	type(color_t), intent(in) :: col
	end subroutine quantum_numbers_init_c
	impure elemental module subroutine quantum_numbers_init_h (qn, hel)
	class(quantum_numbers_t), intent(out) :: qn
	type(helicity_t), intent(in) :: hel
	end subroutine quantum_numbers_init_h
	impure elemental module subroutine quantum_numbers_init_fc (qn, flv, col)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(color_t), intent(in) :: col
	end subroutine quantum_numbers_init_fc
	impure elemental module subroutine quantum_numbers_init_fh (qn, flv, hel)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(helicity_t), intent(in) :: hel
	end subroutine quantum_numbers_init_fh
	impure elemental module subroutine quantum_numbers_init_ch (qn, col, hel)
	class(quantum_numbers_t), intent(out) :: qn
	type(color_t), intent(in) :: col
	type(helicity_t), intent(in) :: hel
	end subroutine quantum_numbers_init_ch
	impure elemental module subroutine quantum_numbers_init_fch (qn, flv, col, hel)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(color_t), intent(in) :: col
	type(helicity_t), intent(in) :: hel
	end subroutine quantum_numbers_init_fch
	impure elemental module subroutine quantum_numbers_init_fs (qn, flv, sub)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	integer, intent(in) :: sub
	end subroutine quantum_numbers_init_fs
	impure elemental module subroutine quantum_numbers_init_fhs (qn, flv, hel, sub)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(helicity_t), intent(in) :: hel
	integer, intent(in) :: sub
	end subroutine quantum_numbers_init_fhs
	impure elemental module subroutine quantum_numbers_init_fcs (qn, flv, col, sub)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(color_t), intent(in) :: col
	integer, intent(in) :: sub
	end subroutine quantum_numbers_init_fcs
	impure elemental module subroutine quantum_numbers_init_fhcs (qn, flv, hel, col, sub)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(helicity_t), intent(in) :: hel
	type(color_t), intent(in) :: col
	integer, intent(in) :: sub
	end subroutine quantum_numbers_init_fhcs
	<<Quantum numbers: procedures>>=
	impure elemental module subroutine quantum_numbers_init_f (qn, flv)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	qn%f = flv
	call qn%c%undefine ()
	call qn%h%undefine ()
	qn%sub = 0
	end subroutine quantum_numbers_init_f

	impure elemental module subroutine quantum_numbers_init_c (qn, col)
	class(quantum_numbers_t), intent(out) :: qn
	type(color_t), intent(in) :: col
	call qn%f%undefine ()
	qn%c = col
	call qn%h%undefine ()
	qn%sub = 0
	end subroutine quantum_numbers_init_c

	impure elemental module subroutine quantum_numbers_init_h (qn, hel)
	class(quantum_numbers_t), intent(out) :: qn
	type(helicity_t), intent(in) :: hel
	call qn%f%undefine ()
	call qn%c%undefine ()
	qn%h = hel
	qn%sub = 0
	end subroutine quantum_numbers_init_h

	impure elemental module subroutine quantum_numbers_init_fc (qn, flv, col)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(color_t), intent(in) :: col
	qn%f = flv
	qn%c = col
	call qn%h%undefine ()
	qn%sub = 0
	end subroutine quantum_numbers_init_fc

	impure elemental module subroutine quantum_numbers_init_fh (qn, flv, hel)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(helicity_t), intent(in) :: hel
	qn%f = flv
	call qn%c%undefine ()
	qn%h = hel
	qn%sub = 0
	end subroutine quantum_numbers_init_fh

	impure elemental module subroutine quantum_numbers_init_ch (qn, col, hel)
	class(quantum_numbers_t), intent(out) :: qn
	type(color_t), intent(in) :: col
	type(helicity_t), intent(in) :: hel
	call qn%f%undefine ()
	qn%c = col
	qn%h = hel
	qn%sub = 0
	end subroutine quantum_numbers_init_ch

	impure elemental module subroutine quantum_numbers_init_fch (qn, flv, col, hel)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(color_t), intent(in) :: col
	type(helicity_t), intent(in) :: hel
	qn%f = flv
	qn%c = col
	qn%h = hel
	qn%sub = 0
	end subroutine quantum_numbers_init_fch

	impure elemental module subroutine quantum_numbers_init_fs (qn, flv, sub)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	integer, intent(in) :: sub
	qn%f = flv; qn%sub = sub
	end subroutine quantum_numbers_init_fs

	impure elemental module subroutine quantum_numbers_init_fhs (qn, flv, hel, sub)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(helicity_t), intent(in) :: hel
	integer, intent(in) :: sub
	qn%f = flv; qn%h = hel; qn%sub = sub
	end subroutine quantum_numbers_init_fhs

	impure elemental module subroutine quantum_numbers_init_fcs (qn, flv, col, sub)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(color_t), intent(in) :: col
	integer, intent(in) :: sub
	qn%f = flv; qn%c = col; qn%sub = sub
	end subroutine quantum_numbers_init_fcs

	impure elemental module subroutine quantum_numbers_init_fhcs (qn, flv, hel, col, sub)
	class(quantum_numbers_t), intent(out) :: qn
	type(flavor_t), intent(in) :: flv
	type(helicity_t), intent(in) :: hel
	type(color_t), intent(in) :: col
	integer, intent(in) :: sub
	qn%f = flv; qn%h = hel; qn%c = col; qn%sub = sub
	end subroutine quantum_numbers_init_fhcs

	@ %def quantum_numbers_init
	@
	\subsection{I/O}
	Write the quantum numbers in condensed form, enclosed by square
	brackets. Color is written only if nontrivial. For convenience,
	introduce also an array version.

	If the [[col_verbose]] option is set, show the quantum number color also
	if it is zero, but defined. Otherwise, suppress zero color.
	<<Quantum numbers: public>>=
	public :: quantum_numbers_write
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: write => quantum_numbers_write_single
	<<Quantum numbers: interfaces>>=
	interface quantum_numbers_write
	module procedure quantum_numbers_write_single
	module procedure quantum_numbers_write_array
	end interface
	<<Quantum numbers: sub interfaces>>=
	module subroutine quantum_numbers_write_single (qn, unit, col_verbose)
	class(quantum_numbers_t), intent(in) :: qn
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: col_verbose
	end subroutine quantum_numbers_write_single
	module subroutine quantum_numbers_write_array (qn, unit, col_verbose)
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: col_verbose
	end subroutine quantum_numbers_write_array
	<<Quantum numbers: procedures>>=
	module subroutine quantum_numbers_write_single (qn, unit, col_verbose)
	class(quantum_numbers_t), intent(in) :: qn
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: col_verbose
	integer :: u
	logical :: col_verb
	u = given_output_unit (unit); if (u < 0) return
	col_verb = .false.; if (present (col_verbose)) col_verb = col_verbose
	write (u, "(A)", advance = "no") "["
	if (qn%f%is_defined ()) then
	call qn%f%write (u)
	if (qn%c%is_nonzero () .or. qn%h%is_defined ()) &
	write (u, "(1x)", advance = "no")
	end if
	if (col_verb) then
	if (qn%c%is_defined () .or. qn%c%is_ghost ()) then
	call color_write (qn%c, u)
	if (qn%h%is_defined ()) write (u, "(1x)", advance = "no")
	end if
	else
	if (qn%c%is_nonzero () .or. qn%c%is_ghost ()) then
	call color_write (qn%c, u)
	if (qn%h%is_defined ()) write (u, "(1x)", advance = "no")
	end if
	end if
	if (qn%h%is_defined ()) then
	call qn%h%write (u)
	end if
	if (qn%sub > 0) &
	write (u, "(A,I0)", advance = "no") " SUB = ", qn%sub
	write (u, "(A)", advance="no") "]"
	end subroutine quantum_numbers_write_single

	module subroutine quantum_numbers_write_array (qn, unit, col_verbose)
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: col_verbose
	integer :: i
	integer :: u
	logical :: col_verb
	u = given_output_unit (unit); if (u < 0) return
	col_verb = .false.; if (present (col_verbose)) col_verb = col_verbose
	write (u, "(A)", advance="no") "["
	do i = 1, size (qn)
	if (i > 1) write (u, "(A)", advance="no") " / "
	if (qn(i)%f%is_defined ()) then
	call qn(i)%f%write (u)
	if (qn(i)%c%is_nonzero () .or. qn(i)%h%is_defined ()) &
	write (u, "(1x)", advance="no")
	end if
	if (col_verb) then
	if (qn(i)%c%is_defined () .or. qn(i)%c%is_ghost ()) then
	call color_write (qn(i)%c, u)
	if (qn(i)%h%is_defined ()) write (u, "(1x)", advance="no")
	end if
	else
	if (qn(i)%c%is_nonzero () .or. qn(i)%c%is_ghost ()) then
	call color_write (qn(i)%c, u)
	if (qn(i)%h%is_defined ()) write (u, "(1x)", advance="no")
	end if
	end if
	if (qn(i)%h%is_defined ()) then
	call qn(i)%h%write (u)
	end if
	if (qn(i)%sub > 0) &
	write (u, "(A,I2)", advance = "no") " SUB = ", qn(i)%sub
	end do
	write (u, "(A)", advance = "no") "]"
	end subroutine quantum_numbers_write_array

	@ %def quantum_numbers_write
	@ Binary I/O.
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: write_raw => quantum_numbers_write_raw
	procedure :: read_raw => quantum_numbers_read_raw
	<<Quantum numbers: sub interfaces>>=
	module subroutine quantum_numbers_write_raw (qn, u)
	class(quantum_numbers_t), intent(in) :: qn
	integer, intent(in) :: u
	end subroutine quantum_numbers_write_raw
	module subroutine quantum_numbers_read_raw (qn, u, iostat)
	class(quantum_numbers_t), intent(out) :: qn
	integer, intent(in) :: u
	integer, intent(out), optional :: iostat
	end subroutine quantum_numbers_read_raw
	<<Quantum numbers: procedures>>=
	module subroutine quantum_numbers_write_raw (qn, u)
	class(quantum_numbers_t), intent(in) :: qn
	integer, intent(in) :: u
	call qn%f%write_raw (u)
	call qn%c%write_raw (u)
	call qn%h%write_raw (u)
	end subroutine quantum_numbers_write_raw

	module subroutine quantum_numbers_read_raw (qn, u, iostat)
	class(quantum_numbers_t), intent(out) :: qn
	integer, intent(in) :: u
	integer, intent(out), optional :: iostat
	call qn%f%read_raw (u, iostat=iostat)
	call qn%c%read_raw (u, iostat=iostat)
	call qn%h%read_raw (u, iostat=iostat)
	end subroutine quantum_numbers_read_raw

	@ %def quantum_numbers_write_raw quantum_numbers_read_raw
	@
	\subsection{Accessing contents}
	Color and helicity can be done by elemental functions. Flavor needs
	impure elemental. We export also the functions directly, this allows
	us to avoid temporaries in some places.
	<<Quantum numbers: public>>=
	public :: quantum_numbers_get_flavor
	public :: quantum_numbers_get_color
	public :: quantum_numbers_get_helicity
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: get_flavor => quantum_numbers_get_flavor
	procedure :: get_color => quantum_numbers_get_color
	procedure :: get_helicity => quantum_numbers_get_helicity
	procedure :: get_sub => quantum_numbers_get_sub
	<<Quantum numbers: sub interfaces>>=
	impure elemental module function quantum_numbers_get_flavor (qn) result (flv)
	type(flavor_t) :: flv
	class(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_get_flavor
	elemental module function quantum_numbers_get_color (qn) result (col)
	type(color_t) :: col
	class(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_get_color
	elemental module function quantum_numbers_get_helicity (qn) result (hel)
	type(helicity_t) :: hel
	class(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_get_helicity
	elemental module function quantum_numbers_get_sub (qn) result (sub)
	integer :: sub
	class(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_get_sub
	<<Quantum numbers: procedures>>=
	impure elemental module function quantum_numbers_get_flavor (qn) result (flv)
	type(flavor_t) :: flv
	class(quantum_numbers_t), intent(in) :: qn
	flv = qn%f
	end function quantum_numbers_get_flavor

	elemental module function quantum_numbers_get_color (qn) result (col)
	type(color_t) :: col
	class(quantum_numbers_t), intent(in) :: qn
	col = qn%c
	end function quantum_numbers_get_color

	elemental module function quantum_numbers_get_helicity (qn) result (hel)
	type(helicity_t) :: hel
	class(quantum_numbers_t), intent(in) :: qn
	hel = qn%h
	end function quantum_numbers_get_helicity

	elemental module function quantum_numbers_get_sub (qn) result (sub)
	integer :: sub
	class(quantum_numbers_t), intent(in) :: qn
	sub = qn%sub
	end function quantum_numbers_get_sub

	@ %def quantum_numbers_get_flavor
	@ %def quantum_numbers_get_color
	@ %def quantum_numbers_get_helicity
	@ %def quantum_numbers_get_sub
	@ This just resets the ghost property of the color part:
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: set_color_ghost => quantum_numbers_set_color_ghost
	<<Quantum numbers: sub interfaces>>=
	elemental module subroutine quantum_numbers_set_color_ghost (qn, ghost)
	class(quantum_numbers_t), intent(inout) :: qn
	logical, intent(in) :: ghost
	end subroutine quantum_numbers_set_color_ghost
	<<Quantum numbers: procedures>>=
	elemental module subroutine quantum_numbers_set_color_ghost (qn, ghost)
	class(quantum_numbers_t), intent(inout) :: qn
	logical, intent(in) :: ghost
	call qn%c%set_ghost (ghost)
	end subroutine quantum_numbers_set_color_ghost

	@ %def quantum_numbers_set_color_ghost
	@ Assign a model to the flavor part of quantum numbers.
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: set_model => quantum_numbers_set_model
	<<Quantum numbers: sub interfaces>>=
	impure elemental module subroutine quantum_numbers_set_model (qn, model)
	class(quantum_numbers_t), intent(inout) :: qn
	class(model_data_t), intent(in), target :: model
	end subroutine quantum_numbers_set_model
	<<Quantum numbers: procedures>>=
	impure elemental module subroutine quantum_numbers_set_model (qn, model)
	class(quantum_numbers_t), intent(inout) :: qn
	class(model_data_t), intent(in), target :: model
	call qn%f%set_model (model)
	end subroutine quantum_numbers_set_model

	@ %def quantum_numbers_set_model
	@ Set the [[radiated]] flag for the flavor component.
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: tag_radiated => quantum_numbers_tag_radiated
	<<Quantum numbers: sub interfaces>>=
	elemental module subroutine quantum_numbers_tag_radiated (qn)
	class(quantum_numbers_t), intent(inout) :: qn
	end subroutine quantum_numbers_tag_radiated
	<<Quantum numbers: procedures>>=
	elemental module subroutine quantum_numbers_tag_radiated (qn)
	class(quantum_numbers_t), intent(inout) :: qn
	call qn%f%tag_radiated ()
	end subroutine quantum_numbers_tag_radiated

	@ %def quantum_numbers_tag_radiated
	@ Set the [[hard_process]] flag for the flavor component.
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: tag_hard_process => quantum_numbers_tag_hard_process
	<<Quantum numbers: sub interfaces>>=
	elemental module subroutine quantum_numbers_tag_hard_process (qn, hard)
	class(quantum_numbers_t), intent(inout) :: qn
	logical, intent(in), optional :: hard
	end subroutine quantum_numbers_tag_hard_process
	<<Quantum numbers: procedures>>=
	elemental module subroutine quantum_numbers_tag_hard_process (qn, hard)
	class(quantum_numbers_t), intent(inout) :: qn
	logical, intent(in), optional :: hard
	call qn%f%tag_hard_process (hard)
	end subroutine quantum_numbers_tag_hard_process

	@ %def quantum_numbers_tag_hard_process
	@
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: set_subtraction_index => &
	quantum_numbers_set_subtraction_index
	<<Quantum numbers: sub interfaces>>=
	elemental module subroutine quantum_numbers_set_subtraction_index (qn, i)
	class(quantum_numbers_t), intent(inout) :: qn
	integer, intent(in) :: i
	end subroutine quantum_numbers_set_subtraction_index
	<<Quantum numbers: procedures>>=
	elemental module subroutine quantum_numbers_set_subtraction_index (qn, i)
	class(quantum_numbers_t), intent(inout) :: qn
	integer, intent(in) :: i
	qn%sub = i
	end subroutine quantum_numbers_set_subtraction_index

	@ %def quantum_numbers_set_subtraction_index
	@
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: get_subtraction_index => &
	quantum_numbers_get_subtraction_index
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_get_subtraction_index &
	(qn) result (sub)
	integer :: sub
	class(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_get_subtraction_index
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_get_subtraction_index &
	(qn) result (sub)
	integer :: sub
	class(quantum_numbers_t), intent(in) :: qn
	sub = qn%sub
	end function quantum_numbers_get_subtraction_index

	@ %def quantum_numbers_get_subtraction_index
	@ This is a convenience function: return the color type for the flavor
	(array).
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: get_color_type => quantum_numbers_get_color_type
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_get_color_type (qn) result (color_type)
	integer :: color_type
	class(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_get_color_type
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_get_color_type (qn) result (color_type)
	integer :: color_type
	class(quantum_numbers_t), intent(in) :: qn
	color_type = qn%f%get_color_type ()
	end function quantum_numbers_get_color_type

	@ %def quantum_numbers_get_color_type
	@
	\subsection{Predicates}
	Check if the flavor index is valid (including UNDEFINED).
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: are_valid => quantum_numbers_are_valid
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_are_valid (qn) result (valid)
	logical :: valid
	class(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_are_valid
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_are_valid (qn) result (valid)
	logical :: valid
	class(quantum_numbers_t), intent(in) :: qn
	valid = qn%f%is_valid ()
	end function quantum_numbers_are_valid

	@ %def quantum_numbers_are_valid
	@ Check if the flavor part has its particle-data pointer associated
	(debugging aid).
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: are_associated => quantum_numbers_are_associated
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_are_associated (qn) result (flag)
	logical :: flag
	class(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_are_associated
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_are_associated (qn) result (flag)
	logical :: flag
	class(quantum_numbers_t), intent(in) :: qn
	flag = qn%f%is_associated ()
	end function quantum_numbers_are_associated

	@ %def quantum_numbers_are_associated
	@ Check if the helicity and color quantum numbers are
	diagonal. (Unpolarized/colorless also counts as diagonal.) Flavor is
	diagonal by definition.
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: are_diagonal => quantum_numbers_are_diagonal
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_are_diagonal (qn) result (diagonal)
	logical :: diagonal
	class(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_are_diagonal
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_are_diagonal (qn) result (diagonal)
	logical :: diagonal
	class(quantum_numbers_t), intent(in) :: qn
	diagonal = qn%h%is_diagonal () .and. qn%c%is_diagonal ()
	end function quantum_numbers_are_diagonal

	@ %def quantum_numbers_are_diagonal
	@ Check if the color part has the ghost property.
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: is_color_ghost => quantum_numbers_is_color_ghost
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_is_color_ghost (qn) result (ghost)
	logical :: ghost
	class(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_is_color_ghost
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_is_color_ghost (qn) result (ghost)
	logical :: ghost
	class(quantum_numbers_t), intent(in) :: qn
	ghost = qn%c%is_ghost ()
	end function quantum_numbers_is_color_ghost

	@ %def quantum_numbers_is_color_ghost
	@ Check if the flavor participates in the hard interaction.
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: are_hard_process => quantum_numbers_are_hard_process
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_are_hard_process &
	(qn) result (hard_process)
	logical :: hard_process
	class(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_are_hard_process
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_are_hard_process &
	(qn) result (hard_process)
	logical :: hard_process
	class(quantum_numbers_t), intent(in) :: qn
	hard_process = qn%f%is_hard_process ()
	end function quantum_numbers_are_hard_process

	@ %def quantum_numbers_are_hard_process
	@
	\subsection{Comparisons}
	Matching and equality is derived from the individual quantum numbers.
	The variant [[fhmatch]] matches only flavor and helicity. The variant
	[[dhmatch]] matches only diagonal helicity, if the matching helicity is
	undefined.
	<<Quantum numbers: public>>=
	public :: quantum_numbers_eq_wo_sub
	<<Quantum numbers: quantum numbers: TBP>>=
	generic :: operator(.match.) => quantum_numbers_match
	generic :: operator(.fmatch.) => quantum_numbers_match_f
	generic :: operator(.hmatch.) => quantum_numbers_match_h
	generic :: operator(.fhmatch.) => quantum_numbers_match_fh
	generic :: operator(.dhmatch.) => quantum_numbers_match_hel_diag
	generic :: operator(==) => quantum_numbers_eq
	generic :: operator(/=) => quantum_numbers_neq
	procedure, private :: quantum_numbers_match
	procedure, private :: quantum_numbers_match_f
	procedure, private :: quantum_numbers_match_h
	procedure, private :: quantum_numbers_match_fh
	procedure, private :: quantum_numbers_match_hel_diag
	procedure, private :: quantum_numbers_eq
	procedure, private :: quantum_numbers_neq
	@ %def .match. == /=
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_match (qn1, qn2) result (match)
	logical :: match
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	end function quantum_numbers_match
	elemental module function quantum_numbers_match_f (qn1, qn2) result (match)
	logical :: match
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	end function quantum_numbers_match_f
	elemental module function quantum_numbers_match_h (qn1, qn2) result (match)
	logical :: match
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	end function quantum_numbers_match_h
	elemental module function quantum_numbers_match_fh (qn1, qn2) result (match)
	logical :: match
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	end function quantum_numbers_match_fh
	elemental module function quantum_numbers_match_hel_diag (qn1, qn2) result (match)
	logical :: match
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	end function quantum_numbers_match_hel_diag
	elemental module function quantum_numbers_eq_wo_sub (qn1, qn2) result (eq)
	logical :: eq
	type(quantum_numbers_t), intent(in) :: qn1, qn2
	end function quantum_numbers_eq_wo_sub
	elemental module function quantum_numbers_eq (qn1, qn2) result (eq)
	logical :: eq
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	end function quantum_numbers_eq
	elemental module function quantum_numbers_neq (qn1, qn2) result (neq)
	logical :: neq
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	end function quantum_numbers_neq
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_match (qn1, qn2) result (match)
	logical :: match
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	match = (qn1%f .match. qn2%f) .and. &
	(qn1%c .match. qn2%c) .and. &
	(qn1%h .match. qn2%h)
	end function quantum_numbers_match

	elemental module function quantum_numbers_match_f (qn1, qn2) result (match)
	logical :: match
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	match = (qn1%f .match. qn2%f)
	end function quantum_numbers_match_f

	elemental module function quantum_numbers_match_h (qn1, qn2) result (match)
	logical :: match
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	match = (qn1%h .match. qn2%h)
	end function quantum_numbers_match_h

	elemental module function quantum_numbers_match_fh (qn1, qn2) result (match)
	logical :: match
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	match = (qn1%f .match. qn2%f) .and. &
	(qn1%h .match. qn2%h)
	end function quantum_numbers_match_fh

	elemental module function quantum_numbers_match_hel_diag (qn1, qn2) result (match)
	logical :: match
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	match = (qn1%f .match. qn2%f) .and. &
	(qn1%c .match. qn2%c) .and. &
	(qn1%h .dmatch. qn2%h)
	end function quantum_numbers_match_hel_diag

	elemental module function quantum_numbers_eq_wo_sub (qn1, qn2) result (eq)
	logical :: eq
	type(quantum_numbers_t), intent(in) :: qn1, qn2
	eq = (qn1%f == qn2%f) .and. &
	(qn1%c == qn2%c) .and. &
	(qn1%h == qn2%h)
	end function quantum_numbers_eq_wo_sub

	elemental module function quantum_numbers_eq (qn1, qn2) result (eq)
	logical :: eq
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	eq = (qn1%f == qn2%f) .and. &
	(qn1%c == qn2%c) .and. &
	(qn1%h == qn2%h) .and. &
	(qn1%sub == qn2%sub)
	end function quantum_numbers_eq

	elemental module function quantum_numbers_neq (qn1, qn2) result (neq)
	logical :: neq
	class(quantum_numbers_t), intent(in) :: qn1, qn2
	neq = (qn1%f /= qn2%f) .or. &
	(qn1%c /= qn2%c) .or. &
	(qn1%h /= qn2%h) .or. &
	(qn1%sub /= qn2%sub)
	end function quantum_numbers_neq

	@ %def quantum_numbers_match
	@ %def quantum_numbers_eq
	@ %def quantum_numbers_neq
	<<Quantum numbers: public>>=
	public :: assignment(=)
	<<Quantum numbers: interfaces>>=
	interface assignment(=)
	module procedure quantum_numbers_assign
	end interface

	<<Quantum numbers: sub interfaces>>=
	module subroutine quantum_numbers_assign (qn_out, qn_in)
	type(quantum_numbers_t), intent(out) :: qn_out
	type(quantum_numbers_t), intent(in) :: qn_in
	end subroutine quantum_numbers_assign
	<<Quantum numbers: procedures>>=
	module subroutine quantum_numbers_assign (qn_out, qn_in)
	type(quantum_numbers_t), intent(out) :: qn_out
	type(quantum_numbers_t), intent(in) :: qn_in
	qn_out%f = qn_in%f
	qn_out%c = qn_in%c
	qn_out%h = qn_in%h
	qn_out%sub = qn_in%sub
	end subroutine quantum_numbers_assign

	@ %def quantum_numbers_assign
	@ Two sets of quantum numbers are compatible if the individual quantum numbers
	are compatible, depending on the mask. Flavor has to match, regardless of the
	flavor mask.

	If the color flag is set, color is compatible if the ghost property is
	identical. If the color flag is unset, color has to be identical. I.e., if
	the flag is set, the color amplitudes can interfere. If it is not set, they
	must be identical, and there must be no ghost. The latter property is used
	for expanding physical color flows.

	Helicity is compatible if the mask is unset, otherwise it has to match. This
	determines if two amplitudes can be multiplied (no mask) or traced (mask).
	<<Quantum numbers: public>>=
	public :: quantum_numbers_are_compatible
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_are_compatible &
	(qn1, qn2, mask) result (flag)
	logical :: flag
	type(quantum_numbers_t), intent(in) :: qn1, qn2
	type(quantum_numbers_mask_t), intent(in) :: mask
	end function quantum_numbers_are_compatible
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_are_compatible &
	(qn1, qn2, mask) result (flag)
	logical :: flag
	type(quantum_numbers_t), intent(in) :: qn1, qn2
	type(quantum_numbers_mask_t), intent(in) :: mask
	if (mask%h .or. mask%hd) then
	flag = (qn1%f .match. qn2%f) .and. (qn1%h .match. qn2%h)
	else
	flag = (qn1%f .match. qn2%f)
	end if
	if (mask%c) then
	flag = flag .and. (qn1%c%is_ghost () .eqv. qn2%c%is_ghost ())
	else
	flag = flag .and. &
	.not. (qn1%c%is_ghost () .or. qn2%c%is_ghost ()) .and. &
	(qn1%c == qn2%c)
	end if
	end function quantum_numbers_are_compatible

	@ %def quantum_numbers_are_compatible
	@ This is the analog for a single quantum-number set. We just check for color
	ghosts; they are excluded if the color mask is unset (color-flow expansion).
	<<Quantum numbers: public>>=
	public :: quantum_numbers_are_physical
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_are_physical (qn, mask) result (flag)
	logical :: flag
	type(quantum_numbers_t), intent(in) :: qn
	type(quantum_numbers_mask_t), intent(in) :: mask
	end function quantum_numbers_are_physical
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_are_physical (qn, mask) result (flag)
	logical :: flag
	type(quantum_numbers_t), intent(in) :: qn
	type(quantum_numbers_mask_t), intent(in) :: mask
	if (mask%c) then
	flag = .true.
	else
	flag = .not. qn%c%is_ghost ()
	end if
	end function quantum_numbers_are_physical

	@ %def quantum_numbers_are_physical
	@
	\subsection{Operations}
	Inherited from the color component: reassign color indices in
	canonical order.
	<<Quantum numbers: public>>=
	public :: quantum_numbers_canonicalize_color
	<<Quantum numbers: sub interfaces>>=
	module subroutine quantum_numbers_canonicalize_color (qn)
	type(quantum_numbers_t), dimension(:), intent(inout) :: qn
	end subroutine quantum_numbers_canonicalize_color
	<<Quantum numbers: procedures>>=
	module subroutine quantum_numbers_canonicalize_color (qn)
	type(quantum_numbers_t), dimension(:), intent(inout) :: qn
	call color_canonicalize (qn%c)
	end subroutine quantum_numbers_canonicalize_color

	@ %def quantum_numbers_canonicalize_color
	@ Inherited from the color component: make a color map for two matching
	quantum-number arrays.
	<<Quantum numbers: public>>=
	public :: make_color_map
	<<Quantum numbers: interfaces>>=
	interface make_color_map
	module procedure quantum_numbers_make_color_map
	end interface make_color_map

	<<Quantum numbers: sub interfaces>>=
	module subroutine quantum_numbers_make_color_map (map, qn1, qn2)
	integer, dimension(:,:), intent(out), allocatable :: map
	type(quantum_numbers_t), dimension(:), intent(in) :: qn1, qn2
	end subroutine quantum_numbers_make_color_map
	<<Quantum numbers: procedures>>=
	module subroutine quantum_numbers_make_color_map (map, qn1, qn2)
	integer, dimension(:,:), intent(out), allocatable :: map
	type(quantum_numbers_t), dimension(:), intent(in) :: qn1, qn2
	call make_color_map (map, qn1%c, qn2%c)
	end subroutine quantum_numbers_make_color_map

	@ %def make_color_map
	@ Inherited from the color component: translate the color part using a
	color-map array
	<<Quantum numbers: public>>=
	public :: quantum_numbers_translate_color
	<<Quantum numbers: interfaces>>=
	interface quantum_numbers_translate_color
	module procedure quantum_numbers_translate_color0
	module procedure quantum_numbers_translate_color1
	end interface

	<<Quantum numbers: sub interfaces>>=
	module subroutine quantum_numbers_translate_color0 (qn, map, offset)
	type(quantum_numbers_t), intent(inout) :: qn
	integer, dimension(:,:), intent(in) :: map
	integer, intent(in), optional :: offset
	end subroutine quantum_numbers_translate_color0
	module subroutine quantum_numbers_translate_color1 (qn, map, offset)
	type(quantum_numbers_t), dimension(:), intent(inout) :: qn
	integer, dimension(:,:), intent(in) :: map
	integer, intent(in), optional :: offset
	end subroutine quantum_numbers_translate_color1
	<<Quantum numbers: procedures>>=
	module subroutine quantum_numbers_translate_color0 (qn, map, offset)
	type(quantum_numbers_t), intent(inout) :: qn
	integer, dimension(:,:), intent(in) :: map
	integer, intent(in), optional :: offset
	call color_translate (qn%c, map, offset)
	end subroutine quantum_numbers_translate_color0

	module subroutine quantum_numbers_translate_color1 (qn, map, offset)
	type(quantum_numbers_t), dimension(:), intent(inout) :: qn
	integer, dimension(:,:), intent(in) :: map
	integer, intent(in), optional :: offset
	call color_translate (qn%c, map, offset)
	end subroutine quantum_numbers_translate_color1

	@ %def quantum_numbers_translate_color
	@ Inherited from the color component: return the color index with
	highest absolute value.

	Since the algorithm is not elemental, we keep the separate
	procedures for different array rank.
	<<Quantum numbers: public>>=
	public :: quantum_numbers_get_max_color_value
	<<Quantum numbers: interfaces>>=
	interface quantum_numbers_get_max_color_value
	module procedure quantum_numbers_get_max_color_value0
	module procedure quantum_numbers_get_max_color_value1
	module procedure quantum_numbers_get_max_color_value2
	end interface

	<<Quantum numbers: sub interfaces>>=
	pure module function quantum_numbers_get_max_color_value0 (qn) result (cmax)
	integer :: cmax
	type(quantum_numbers_t), intent(in) :: qn
	end function quantum_numbers_get_max_color_value0
	pure module function quantum_numbers_get_max_color_value1 (qn) result (cmax)
	integer :: cmax
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	end function quantum_numbers_get_max_color_value1
	pure module function quantum_numbers_get_max_color_value2 (qn) result (cmax)
	integer :: cmax
	type(quantum_numbers_t), dimension(:,:), intent(in) :: qn
	end function quantum_numbers_get_max_color_value2
	<<Quantum numbers: procedures>>=
	pure module function quantum_numbers_get_max_color_value0 (qn) result (cmax)
	integer :: cmax
	type(quantum_numbers_t), intent(in) :: qn
	cmax = color_get_max_value (qn%c)
	end function quantum_numbers_get_max_color_value0

	pure module function quantum_numbers_get_max_color_value1 (qn) result (cmax)
	integer :: cmax
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	cmax = color_get_max_value (qn%c)
	end function quantum_numbers_get_max_color_value1

	pure module function quantum_numbers_get_max_color_value2 (qn) result (cmax)
	integer :: cmax
	type(quantum_numbers_t), dimension(:,:), intent(in) :: qn
	cmax = color_get_max_value (qn%c)
	end function quantum_numbers_get_max_color_value2

	@ Inherited from the color component: add an offset to the indices of
	the color part
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: add_color_offset => quantum_numbers_add_color_offset
	<<Quantum numbers: sub interfaces>>=
	elemental module subroutine quantum_numbers_add_color_offset (qn, offset)
	class(quantum_numbers_t), intent(inout) :: qn
	integer, intent(in) :: offset
	end subroutine quantum_numbers_add_color_offset
	<<Quantum numbers: procedures>>=
	elemental module subroutine quantum_numbers_add_color_offset (qn, offset)
	class(quantum_numbers_t), intent(inout) :: qn
	integer, intent(in) :: offset
	call qn%c%add_offset (offset)
	end subroutine quantum_numbers_add_color_offset

	@ %def quantum_numbers_add_color_offset
	@ Given a quantum number array, return all possible color
	contractions, leaving the other quantum numbers intact.
	<<Quantum numbers: public>>=
	public :: quantum_number_array_make_color_contractions
	<<Quantum numbers: sub interfaces>>=
	module subroutine quantum_number_array_make_color_contractions (qn_in, qn_out)
	type(quantum_numbers_t), dimension(:), intent(in) :: qn_in
	type(quantum_numbers_t), dimension(:,:), intent(out), allocatable :: qn_out
	end subroutine quantum_number_array_make_color_contractions
	<<Quantum numbers: procedures>>=
	module subroutine quantum_number_array_make_color_contractions (qn_in, qn_out)
	type(quantum_numbers_t), dimension(:), intent(in) :: qn_in
	type(quantum_numbers_t), dimension(:,:), intent(out), allocatable :: qn_out
	type(color_t), dimension(:,:), allocatable :: col
	integer :: i
	call color_array_make_contractions (qn_in%c, col)
	allocate (qn_out (size (col, 1), size (col, 2)))
	do i = 1, size (qn_out, 2)
	qn_out(:,i)%f = qn_in%f
	qn_out(:,i)%c = col(:,i)
	qn_out(:,i)%h = qn_in%h
	end do
	end subroutine quantum_number_array_make_color_contractions

	@ %def quantum_number_array_make_color_contractions
	@ Inherited from the color component: invert the color, switching
	particle/antiparticle.
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: invert_color => quantum_numbers_invert_color
	<<Quantum numbers: sub interfaces>>=
	elemental module subroutine quantum_numbers_invert_color (qn)
	class(quantum_numbers_t), intent(inout) :: qn
	end subroutine quantum_numbers_invert_color
	<<Quantum numbers: procedures>>=
	elemental module subroutine quantum_numbers_invert_color (qn)
	class(quantum_numbers_t), intent(inout) :: qn
	call qn%c%invert ()
	end subroutine quantum_numbers_invert_color

	@ %def quantum_numbers_invert_color
	@ Flip helicity.
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: flip_helicity => quantum_numbers_flip_helicity
	<<Quantum numbers: sub interfaces>>=
	elemental module subroutine quantum_numbers_flip_helicity (qn)
	class(quantum_numbers_t), intent(inout) :: qn
	end subroutine quantum_numbers_flip_helicity
	<<Quantum numbers: procedures>>=
	elemental module subroutine quantum_numbers_flip_helicity (qn)
	class(quantum_numbers_t), intent(inout) :: qn
	call qn%h%flip ()
	end subroutine quantum_numbers_flip_helicity

	@ %def quantum_numbers_flip_helicity
	@
	Merge two quantum number sets: for each entry, if both are defined,
	combine them to an off-diagonal entry (meaningful only if the input
	was diagonal). If either entry is undefined, take the defined
	one.

	For flavor, off-diagonal entries are invalid, so both
	flavors must be equal, otherwise an invalid flavor is inserted.
	<<Quantum numbers: public>>=
	public :: operator(.merge.)
	<<Quantum numbers: interfaces>>=
	interface operator(.merge.)
	module procedure merge_quantum_numbers0
	module procedure merge_quantum_numbers1
	end interface

	<<Quantum numbers: sub interfaces>>=
	module function merge_quantum_numbers0 (qn1, qn2) result (qn3)
	type(quantum_numbers_t) :: qn3
	type(quantum_numbers_t), intent(in) :: qn1, qn2
	end function merge_quantum_numbers0
	module function merge_quantum_numbers1 (qn1, qn2) result (qn3)
	type(quantum_numbers_t), dimension(:), intent(in) :: qn1, qn2
	type(quantum_numbers_t), dimension(size(qn1)) :: qn3
	end function merge_quantum_numbers1
	<<Quantum numbers: procedures>>=
	module function merge_quantum_numbers0 (qn1, qn2) result (qn3)
	type(quantum_numbers_t) :: qn3
	type(quantum_numbers_t), intent(in) :: qn1, qn2
	qn3%f = qn1%f .merge. qn2%f
	qn3%c = qn1%c .merge. qn2%c
	qn3%h = qn1%h .merge. qn2%h
	qn3%sub = merge_subtraction_index (qn1%sub, qn2%sub)
	end function merge_quantum_numbers0

	module function merge_quantum_numbers1 (qn1, qn2) result (qn3)
	type(quantum_numbers_t), dimension(:), intent(in) :: qn1, qn2
	type(quantum_numbers_t), dimension(size(qn1)) :: qn3
	qn3%f = qn1%f .merge. qn2%f
	qn3%c = qn1%c .merge. qn2%c
	qn3%h = qn1%h .merge. qn2%h
	qn3%sub = merge_subtraction_index (qn1%sub, qn2%sub)
	end function merge_quantum_numbers1

	@ %def merge_quantum_numbers
	@
	<<Quantum numbers: procedures>>=
	elemental function merge_subtraction_index (sub1, sub2) result (sub3)
	integer :: sub3
	integer, intent(in) :: sub1, sub2
	if (sub1 > 0 .and. sub2 > 0) then
	if (sub1 == sub2) then
	sub3 = sub1
	else
	sub3 = 0
	end if
	else if (sub1 > 0) then
	sub3 = sub1
	else if (sub2 > 0) then
	sub3 = sub2
	else
	sub3 = 0
	end if
	end function merge_subtraction_index

	@ %def merge_subtraction_index
	@
	\subsection{The quantum number mask}
	The quantum numbers mask is true for quantum numbers that should be
	ignored or summed over. The three mandatory entries correspond to
	flavor, color, and helicity, respectively.

	There is an additional entry [[cg]]: If false, the color-ghosts
	property should be kept even if color is ignored. This is relevant
	only if [[c]] is set, otherwise it is always false.

	The flag [[hd]] tells that only diagonal entries in helicity should be
	kept. If [[h]] is set, [[hd]] is irrelevant and will be kept
	[[.false.]]
	<<Quantum numbers: public>>=
	public :: quantum_numbers_mask_t
	<<Quantum numbers: types>>=
	type :: quantum_numbers_mask_t
	private
	logical :: f = .false.
	logical :: c = .false.
	logical :: cg = .false.
	logical :: h = .false.
	logical :: hd = .false.
	integer :: sub = 0
	contains
	<<Quantum numbers: quantum numbers mask: TBP>>
	end type quantum_numbers_mask_t

	@ %def quantum_numbers_mask_t
	@ Define a quantum number mask: Constructor form
	<<Quantum numbers: public>>=
	public :: quantum_numbers_mask
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_mask &
	(mask_f, mask_c, mask_h, mask_cg, mask_hd) result (mask)
	type(quantum_numbers_mask_t) :: mask
	logical, intent(in) :: mask_f, mask_c, mask_h
	logical, intent(in), optional :: mask_cg
	logical, intent(in), optional :: mask_hd
	end function quantum_numbers_mask
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_mask &
	(mask_f, mask_c, mask_h, mask_cg, mask_hd) result (mask)
	type(quantum_numbers_mask_t) :: mask
	logical, intent(in) :: mask_f, mask_c, mask_h
	logical, intent(in), optional :: mask_cg
	logical, intent(in), optional :: mask_hd
	call quantum_numbers_mask_init &
	(mask, mask_f, mask_c, mask_h, mask_cg, mask_hd)
	end function quantum_numbers_mask

	@ %def new_quantum_numbers_mask
	@ Define quantum numbers: Initializer form
	<<Quantum numbers: quantum numbers mask: TBP>>=
	procedure :: init => quantum_numbers_mask_init
	<<Quantum numbers: sub interfaces>>=
	elemental module subroutine quantum_numbers_mask_init &
	(mask, mask_f, mask_c, mask_h, mask_cg, mask_hd)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	logical, intent(in) :: mask_f, mask_c, mask_h
	logical, intent(in), optional :: mask_cg, mask_hd
	end subroutine quantum_numbers_mask_init
	<<Quantum numbers: procedures>>=
	elemental module subroutine quantum_numbers_mask_init &
	(mask, mask_f, mask_c, mask_h, mask_cg, mask_hd)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	logical, intent(in) :: mask_f, mask_c, mask_h
	logical, intent(in), optional :: mask_cg, mask_hd
	mask%f = mask_f
	mask%c = mask_c
	mask%h = mask_h
	mask%cg = .false.
	if (present (mask_cg)) then
	if (mask%c) mask%cg = mask_cg
	else
	mask%cg = mask_c
	end if
	mask%hd = .false.
	if (present (mask_hd)) then
	if (.not. mask%h) mask%hd = mask_hd
	end if
	end subroutine quantum_numbers_mask_init

	@ %def quantum_numbers_mask_init
	@ Write a quantum numbers mask. We need the stand-alone subroutine for the
	array case.
	<<Quantum numbers: public>>=
	public :: quantum_numbers_mask_write
	<<Quantum numbers: interfaces>>=
	interface quantum_numbers_mask_write
	module procedure quantum_numbers_mask_write_single
	module procedure quantum_numbers_mask_write_array
	end interface
	<<Quantum numbers: quantum numbers mask: TBP>>=
	procedure :: write => quantum_numbers_mask_write_single
	<<Quantum numbers: sub interfaces>>=
	module subroutine quantum_numbers_mask_write_single (mask, unit)
	class(quantum_numbers_mask_t), intent(in) :: mask
	integer, intent(in), optional :: unit
	end subroutine quantum_numbers_mask_write_single
	module subroutine quantum_numbers_mask_write_array (mask, unit)
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	integer, intent(in), optional :: unit
	end subroutine quantum_numbers_mask_write_array
	<<Quantum numbers: procedures>>=
	module subroutine quantum_numbers_mask_write_single (mask, unit)
	class(quantum_numbers_mask_t), intent(in) :: mask
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A)", advance="no") "["
	write (u, "(L1)", advance="no") mask%f
	write (u, "(L1)", advance="no") mask%c
	if (.not.mask%cg) write (u, "('g')", advance="no")
	write (u, "(L1)", advance="no") mask%h
	if (mask%hd) write (u, "('d')", advance="no")
	write (u, "(A)", advance="no") "]"
	end subroutine quantum_numbers_mask_write_single

	module subroutine quantum_numbers_mask_write_array (mask, unit)
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A)", advance="no") "["
	do i = 1, size (mask)
	if (i > 1) write (u, "(A)", advance="no") "/"
	write (u, "(L1)", advance="no") mask(i)%f
	write (u, "(L1)", advance="no") mask(i)%c
	if (.not.mask(i)%cg) write (u, "('g')", advance="no")
	write (u, "(L1)", advance="no") mask(i)%h
	if (mask(i)%hd) write (u, "('d')", advance="no")
	end do
	write (u, "(A)", advance="no") "]"
	end subroutine quantum_numbers_mask_write_array

	@ %def quantum_numbers_mask_write
	@
	\subsection{Setting mask components}
	<<Quantum numbers: quantum numbers mask: TBP>>=
	procedure :: set_flavor => quantum_numbers_mask_set_flavor
	procedure :: set_color => quantum_numbers_mask_set_color
	procedure :: set_helicity => quantum_numbers_mask_set_helicity
	procedure :: set_sub => quantum_numbers_mask_set_sub
	<<Quantum numbers: sub interfaces>>=
	elemental module subroutine quantum_numbers_mask_set_flavor (mask, mask_f)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	logical, intent(in) :: mask_f
	end subroutine quantum_numbers_mask_set_flavor
	elemental module subroutine quantum_numbers_mask_set_color (mask, mask_c, mask_cg)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	logical, intent(in) :: mask_c
	logical, intent(in), optional :: mask_cg
	end subroutine quantum_numbers_mask_set_color
	elemental module subroutine quantum_numbers_mask_set_helicity (mask, mask_h, mask_hd)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	logical, intent(in) :: mask_h
	logical, intent(in), optional :: mask_hd
	end subroutine quantum_numbers_mask_set_helicity
	elemental module subroutine quantum_numbers_mask_set_sub (mask, sub)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	integer, intent(in) :: sub
	end subroutine quantum_numbers_mask_set_sub
	<<Quantum numbers: procedures>>=
	elemental module subroutine quantum_numbers_mask_set_flavor (mask, mask_f)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	logical, intent(in) :: mask_f
	mask%f = mask_f
	end subroutine quantum_numbers_mask_set_flavor

	elemental module subroutine quantum_numbers_mask_set_color (mask, mask_c, mask_cg)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	logical, intent(in) :: mask_c
	logical, intent(in), optional :: mask_cg
	mask%c = mask_c
	if (present (mask_cg)) then
	if (mask%c) mask%cg = mask_cg
	else
	mask%cg = mask_c
	end if
	end subroutine quantum_numbers_mask_set_color

	elemental module subroutine quantum_numbers_mask_set_helicity (mask, mask_h, mask_hd)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	logical, intent(in) :: mask_h
	logical, intent(in), optional :: mask_hd
	mask%h = mask_h
	if (present (mask_hd)) then
	if (.not. mask%h) mask%hd = mask_hd
	end if
	end subroutine quantum_numbers_mask_set_helicity

	elemental module subroutine quantum_numbers_mask_set_sub (mask, sub)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	integer, intent(in) :: sub
	mask%sub = sub
	end subroutine quantum_numbers_mask_set_sub

	@ %def quantum_numbers_mask_set_flavor
	@ %def quantum_numbers_mask_set_color
	@ %def quantum_numbers_mask_set_helicity
	@ %def quantum_numbers_mask_set_sub
	@ The following routines assign part of a mask, depending on the flags given.
	<<Quantum numbers: quantum numbers mask: TBP>>=
	procedure :: assign => quantum_numbers_mask_assign
	<<Quantum numbers: sub interfaces>>=
	elemental module subroutine quantum_numbers_mask_assign &
	(mask, mask_in, flavor, color, helicity)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	class(quantum_numbers_mask_t), intent(in) :: mask_in
	logical, intent(in), optional :: flavor, color, helicity
	end subroutine quantum_numbers_mask_assign
	<<Quantum numbers: procedures>>=
	elemental module subroutine quantum_numbers_mask_assign &
	(mask, mask_in, flavor, color, helicity)
	class(quantum_numbers_mask_t), intent(inout) :: mask
	class(quantum_numbers_mask_t), intent(in) :: mask_in
	logical, intent(in), optional :: flavor, color, helicity
	if (present (flavor)) then
	if (flavor) then
	mask%f = mask_in%f
	end if
	end if
	if (present (color)) then
	if (color) then
	mask%c = mask_in%c
	mask%cg = mask_in%cg
	end if
	end if
	if (present (helicity)) then
	if (helicity) then
	mask%h = mask_in%h
	mask%hd = mask_in%hd
	end if
	end if
	end subroutine quantum_numbers_mask_assign

	@ %def quantum_numbers_mask_assign
	@
	\subsection{Mask predicates}
	Return true if either one of the entries is set:
	<<Quantum numbers: public>>=
	public :: any
	<<Quantum numbers: interfaces>>=
	interface any
	module procedure quantum_numbers_mask_any
	end interface
	<<Quantum numbers: sub interfaces>>=
	module function quantum_numbers_mask_any (mask) result (match)
	logical :: match
	type(quantum_numbers_mask_t), intent(in) :: mask
	end function quantum_numbers_mask_any
	<<Quantum numbers: procedures>>=
	module function quantum_numbers_mask_any (mask) result (match)
	logical :: match
	type(quantum_numbers_mask_t), intent(in) :: mask
	match = mask%f .or. mask%c .or. mask%h .or. mask%hd
	end function quantum_numbers_mask_any

	@ %def any
	@
	\subsection{Operators}
	The OR operation is applied to all components.
	<<Quantum numbers: quantum numbers mask: TBP>>=
	generic :: operator(.or.) => quantum_numbers_mask_or
	procedure, private :: quantum_numbers_mask_or
	@ %def .or.
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_mask_or (mask1, mask2) result (mask)
	type(quantum_numbers_mask_t) :: mask
	class(quantum_numbers_mask_t), intent(in) :: mask1, mask2
	end function quantum_numbers_mask_or
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_mask_or (mask1, mask2) result (mask)
	type(quantum_numbers_mask_t) :: mask
	class(quantum_numbers_mask_t), intent(in) :: mask1, mask2
	mask%f = mask1%f .or. mask2%f
	mask%c = mask1%c .or. mask2%c
	if (mask%c) mask%cg = mask1%cg .or. mask2%cg
	mask%h = mask1%h .or. mask2%h
	if (.not. mask%h) mask%hd = mask1%hd .or. mask2%hd
	end function quantum_numbers_mask_or

	@ %def quantum_numbers_mask_or
	@
	\subsection{Mask comparisons}
	Return true if the two masks are equivalent / differ:
	<<Quantum numbers: quantum numbers mask: TBP>>=
	generic :: operator(.eqv.) => quantum_numbers_mask_eqv
	generic :: operator(.neqv.) => quantum_numbers_mask_neqv
	procedure, private :: quantum_numbers_mask_eqv
	procedure, private :: quantum_numbers_mask_neqv
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_mask_eqv (mask1, mask2) result (eqv)
	logical :: eqv
	class(quantum_numbers_mask_t), intent(in) :: mask1, mask2
	end function quantum_numbers_mask_eqv
	elemental module function quantum_numbers_mask_neqv (mask1, mask2) result (neqv)
	logical :: neqv
	class(quantum_numbers_mask_t), intent(in) :: mask1, mask2
	end function quantum_numbers_mask_neqv
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_mask_eqv (mask1, mask2) result (eqv)
	logical :: eqv
	class(quantum_numbers_mask_t), intent(in) :: mask1, mask2
	eqv = (mask1%f .eqv. mask2%f) .and. &
	(mask1%c .eqv. mask2%c) .and. &
	(mask1%cg .eqv. mask2%cg) .and. &
	(mask1%h .eqv. mask2%h) .and. &
	(mask1%hd .eqv. mask2%hd)
	end function quantum_numbers_mask_eqv

	elemental module function quantum_numbers_mask_neqv (mask1, mask2) result (neqv)
	logical :: neqv
	class(quantum_numbers_mask_t), intent(in) :: mask1, mask2
	neqv = (mask1%f .neqv. mask2%f) .or. &
	(mask1%c .neqv. mask2%c) .or. &
	(mask1%cg .neqv. mask2%cg) .or. &
	(mask1%h .neqv. mask2%h) .or. &
	(mask1%hd .neqv. mask2%hd)
	end function quantum_numbers_mask_neqv

	@ %def .eqv. .neqv.
	@
	\subsection{Apply a mask}
	Applying a mask to the quantum number object means undefining those
	entries where the mask is set. The others remain unaffected.

	The [[hd]] mask has the special property that it ``diagonalizes''
	helicity, i.e., the second helicity entry is dropped and the result is
	a diagonal helicity quantum number.
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: undefine => quantum_numbers_undefine
	procedure :: undefined => quantum_numbers_undefined0
	<<Quantum numbers: public>>=
	public :: quantum_numbers_undefined
	<<Quantum numbers: interfaces>>=
	interface quantum_numbers_undefined
	module procedure quantum_numbers_undefined0
	module procedure quantum_numbers_undefined1
	module procedure quantum_numbers_undefined11
	end interface

	<<Quantum numbers: sub interfaces>>=
	elemental module subroutine quantum_numbers_undefine (qn, mask)
	class(quantum_numbers_t), intent(inout) :: qn
	type(quantum_numbers_mask_t), intent(in) :: mask
	end subroutine quantum_numbers_undefine
	module function quantum_numbers_undefined0 (qn, mask) result (qn_new)
	class(quantum_numbers_t), intent(in) :: qn
	type(quantum_numbers_mask_t), intent(in) :: mask
	type(quantum_numbers_t) :: qn_new
	end function quantum_numbers_undefined0
	module function quantum_numbers_undefined1 (qn, mask) result (qn_new)
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	type(quantum_numbers_mask_t), intent(in) :: mask
	type(quantum_numbers_t), dimension(size(qn)) :: qn_new
	end function quantum_numbers_undefined1
	module function quantum_numbers_undefined11 (qn, mask) result (qn_new)
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	type(quantum_numbers_t), dimension(size(qn)) :: qn_new
	end function quantum_numbers_undefined11
	<<Quantum numbers: procedures>>=
	elemental module subroutine quantum_numbers_undefine (qn, mask)
	class(quantum_numbers_t), intent(inout) :: qn
	type(quantum_numbers_mask_t), intent(in) :: mask
	if (mask%f) call qn%f%undefine ()
	if (mask%c) call qn%c%undefine (undefine_ghost = mask%cg)
	if (mask%h) then
	call qn%h%undefine ()
	else if (mask%hd) then
	if (.not. qn%h%is_diagonal ()) then
	call qn%h%diagonalize ()
	end if
	end if
	if (mask%sub > 0) qn%sub = 0
	end subroutine quantum_numbers_undefine

	module function quantum_numbers_undefined0 (qn, mask) result (qn_new)
	class(quantum_numbers_t), intent(in) :: qn
	type(quantum_numbers_mask_t), intent(in) :: mask
	type(quantum_numbers_t) :: qn_new
	select type (qn)
	type is (quantum_numbers_t); qn_new = qn
	end select
	call quantum_numbers_undefine (qn_new, mask)
	end function quantum_numbers_undefined0

	module function quantum_numbers_undefined1 (qn, mask) result (qn_new)
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	type(quantum_numbers_mask_t), intent(in) :: mask
	type(quantum_numbers_t), dimension(size(qn)) :: qn_new
	qn_new = qn
	call quantum_numbers_undefine (qn_new, mask)
	end function quantum_numbers_undefined1

	module function quantum_numbers_undefined11 (qn, mask) result (qn_new)
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	type(quantum_numbers_t), dimension(size(qn)) :: qn_new
	qn_new = qn
	call quantum_numbers_undefine (qn_new, mask)
	end function quantum_numbers_undefined11

	@ %def quantum_numbers_undefine
	@ %def quantum_numbers_undefined
	@ Return true if the input quantum number set has entries that would
	be removed by the applied mask, e.g., if polarization is defined but
	[[mask%h]] is set:
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: are_redundant => quantum_numbers_are_redundant
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_are_redundant (qn, mask) &
	result (redundant)
	logical :: redundant
	class(quantum_numbers_t), intent(in) :: qn
	type(quantum_numbers_mask_t), intent(in) :: mask
	end function quantum_numbers_are_redundant
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_are_redundant (qn, mask) &
	result (redundant)
	logical :: redundant
	class(quantum_numbers_t), intent(in) :: qn
	type(quantum_numbers_mask_t), intent(in) :: mask
	redundant = .false.
	if (mask%f) then
	redundant = qn%f%is_defined ()
	end if
	if (mask%c) then
	redundant = qn%c%is_defined ()
	end if
	if (mask%h) then
	redundant = qn%h%is_defined ()
	else if (mask%hd) then
	redundant = .not. qn%h%is_diagonal ()
	end if
	if (mask%sub > 0) redundant = qn%sub >= mask%sub
	end function quantum_numbers_are_redundant

	@ %def quantum_numbers_are_redundant
	@ Return true if the helicity flag is set or the diagonal-helicity flag is
	set.
	<<Quantum numbers: quantum numbers mask: TBP>>=
	procedure :: diagonal_helicity => quantum_numbers_mask_diagonal_helicity
	<<Quantum numbers: sub interfaces>>=
	elemental module function quantum_numbers_mask_diagonal_helicity (mask) &
	result (flag)
	logical :: flag
	class(quantum_numbers_mask_t), intent(in) :: mask
	end function quantum_numbers_mask_diagonal_helicity
	<<Quantum numbers: procedures>>=
	elemental module function quantum_numbers_mask_diagonal_helicity (mask) &
	result (flag)
	logical :: flag
	class(quantum_numbers_mask_t), intent(in) :: mask
	flag = mask%h .or. mask%hd
	end function quantum_numbers_mask_diagonal_helicity

	@ %def quantum_numbers_mask_diagonal_helicity
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Transition Matrices and Evaluation}

	The modules in this chapter implement transition matrices and calculations.
	The functionality is broken down in three modules
	\begin{description}
	\item[state\_matrices]
	represent state and transition density matrices built from particle quantum
	numbers (helicity, color, flavor)
	\item[interactions]
	extend state matrices with the record of particle momenta. They also
	distinguish in- and out-particles and store parent-child relations.
	\item[evaluators]
	These objects extend interaction objects by the information how to calculate
	matrix elements from products and squares of other interactions. They
	implement the methods to actually compute those matrix elements.
	\end{description}

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{State matrices}
	This module deals with the internal state of a particle system, i.e.,
	with its density matrix in flavor, color, and helicity space.
	<<[[state_matrices.f90]]>>=
	<<File header>>

	module state_matrices

	<<Use kinds>>
	use model_data
	use flavors
	use colors
	use helicities
	use quantum_numbers

	<<Standard module head>>

	<<State matrices: public>>

	<<State matrices: parameters>>

	<<State matrices: types>>

	<<State matrices: interfaces>>

	interface
	<<State matrices: sub interfaces>>
	end interface

	end module state_matrices
	@ %def state_matrices
	@
	<<[[state_matrices_sub.f90]]>>=
	<<File header>>

	submodule (state_matrices) state_matrices_s

	use constants, only: zero
	use format_utils, only: pac_fmt
	use format_defs, only: FMT_17, FMT_19
	use io_units
	use diagnostics
	use sorting

	implicit none

	contains

	<<State matrices: procedures>>

	end submodule state_matrices_s

	@ %def state_matrices_s
	@
	\subsection{Nodes of the quantum state trie}
	A quantum state object represents an unnormalized density matrix,
	i.e., an array of possibilities for flavor, color, and helicity
	indices with associated complex values. Physically, the trace of this
	matrix is the summed squared matrix element for an interaction, and
	the matrix elements divided by this value correspond to the
	flavor-color-helicity density matrix. (Flavor and color are
	diagonal.)

	We store density matrices as tries, that is, as trees where each
	branching represents the possible quantum numbers of a particle. The
	first branching is the first particle in the system. A leaf (the node
	corresponding to the last particle) contains the value of the matrix
	element.

	Each node contains a flavor, color, and helicity entry. Note that
	each of those entries may be actually undefined, so we can also represent,
	e.g., unpolarized particles.

	The value is meaningful only for leaves, which have no child nodes.
	There is a pointer to the parent node which allows for following the
	trie downwards from a leaf, it is null for a root node. The child
	nodes are implemented as a list, so there is a pointer to the first
	and last child, and each node also has a [[next]] pointer to the next
	sibling.

	The root node does not correspond to a particle, only its children do.
	The quantum numbers of the root node are irrelevant and will not be
	set. However, we use a common type for the three classes (root,
	branch, leaf); they may easily be distinguished by the association
	status of parent and child.

	\subsubsection{Node type}
	The node is linked in all directions: the parent, the first and last
	in the list of children, and the previous and next sibling. This allows
	us for adding and removing nodes and whole branches anywhere in the
	trie. (Circular links are not allowed, however.). The node holds its
	associated set of quantum numbers. The integer index, which is set
	only for leaf nodes, is the index of the corresponding matrix element
	value within the state matrix.

	Temporarily, matrix-element values may be stored within a leaf node.
	This is used during state-matrix factorization. When the state matrix
	is [[freeze]]d, these values are transferred to the matrix-element
	array within the host state matrix.
	<<State matrices: types>>=
	type :: node_t
	private
	type(quantum_numbers_t) :: qn
	type(node_t), pointer :: parent => null ()
	type(node_t), pointer :: child_first => null ()
	type(node_t), pointer :: child_last => null ()
	type(node_t), pointer :: next => null ()
	type(node_t), pointer :: previous => null ()
	integer :: me_index = 0
	integer, dimension(:), allocatable :: me_count
	complex(default) :: me = 0
	end type node_t

	@ %def node_t
	@
	\subsubsection{Operations on nodes}
	Recursively deallocate all children of the current
	node. This includes any values associated with the children.
	<<State matrices: procedures>>=
	pure recursive subroutine node_delete_offspring (node)
	type(node_t), pointer :: node
	type(node_t), pointer :: child
	child => node%child_first
	do while (associated (child))
	node%child_first => node%child_first%next
	call node_delete_offspring (child)
	deallocate (child)
	child => node%child_first
	end do
	node%child_last => null ()
	end subroutine node_delete_offspring

	@ %def node_delete_offspring
	@ Remove a node including its offspring. Adjust the pointers of
	parent and siblings, if necessary.
	<<State matrices: procedures>>=
	pure subroutine node_delete (node)
	type(node_t), pointer :: node
	call node_delete_offspring (node)
	if (associated (node%previous)) then
	node%previous%next => node%next
	else if (associated (node%parent)) then
	node%parent%child_first => node%next
	end if
	if (associated (node%next)) then
	node%next%previous => node%previous
	else if (associated (node%parent)) then
	node%parent%child_last => node%previous
	end if
	deallocate (node)
	end subroutine node_delete

	@ %def node_delete
	@ Append a child node
	<<State matrices: procedures>>=
	subroutine node_append_child (node, child)
	type(node_t), target, intent(inout) :: node
	type(node_t), pointer :: child
	allocate (child)
	if (associated (node%child_last)) then
	node%child_last%next => child
	child%previous => node%child_last
	else
	node%child_first => child
	end if
	node%child_last => child
	child%parent => node
	end subroutine node_append_child

	@ %def node_append_child
	@
	\subsubsection{I/O}
	Output of a single node, no recursion. We print the quantum numbers
	in square brackets, then the value (if any).
	<<State matrices: procedures>>=
	subroutine node_write (node, me_array, verbose, unit, col_verbose, testflag)
	type(node_t), intent(in) :: node
	complex(default), dimension(:), intent(in), optional :: me_array
	logical, intent(in), optional :: verbose, col_verbose, testflag
	integer, intent(in), optional :: unit
	logical :: verb
	integer :: u
	character(len=7) :: fmt
	call pac_fmt (fmt, FMT_19, FMT_17, testflag)
	verb = .false.; if (present (verbose)) verb = verbose
	u = given_output_unit (unit); if (u < 0) return
	call node%qn%write (u, col_verbose)
	if (node%me_index /= 0) then
	write (u, "(A,I0,A)", advance="no") " => ME(", node%me_index, ")"
	if (present (me_array)) then
	write (u, "(A)", advance="no") " = "
	write (u, "('('," // fmt // ",','," // fmt // ",')')", &
	advance="no") pacify_complex (me_array(node%me_index))
	end if
	end if
	write (u, *)
	if (verb) then
	call ptr_write ("parent ", node%parent)
	call ptr_write ("child_first", node%child_first)
	call ptr_write ("child_last ", node%child_last)
	call ptr_write ("next ", node%next)
	call ptr_write ("previous ", node%previous)
	end if
	contains
	subroutine ptr_write (label, node)
	character(*), intent(in) :: label
	type(node_t), pointer :: node
	if (associated (node)) then
	write (u, "(10x,A,1x,'->',1x)", advance="no") label
	call node%qn%write (u, col_verbose)
	write (u, *)
	end if
	end subroutine ptr_write
	end subroutine node_write

	@ %def node_write
	@ Recursive output of a node:
	<<State matrices: procedures>>=
	recursive subroutine node_write_rec (node, me_array, verbose, &
	indent, unit, col_verbose, testflag)
	type(node_t), intent(in), target :: node
	complex(default), dimension(:), intent(in), optional :: me_array
	logical, intent(in), optional :: verbose, col_verbose, testflag
	integer, intent(in), optional :: indent
	integer, intent(in), optional :: unit
	type(node_t), pointer :: current
	logical :: verb
	integer :: i, u
	verb = .false.; if (present (verbose)) verb = verbose
	i = 0; if (present (indent)) i = indent
	u = given_output_unit (unit); if (u < 0) return
	current => node%child_first
	do while (associated (current))
	write (u, "(A)", advance="no") repeat (" ", i)
	call node_write (current, me_array, verbose = verb, &
	unit = u, col_verbose = col_verbose, testflag = testflag)
	call node_write_rec (current, me_array, verbose = verb, &
	indent = i + 2, unit = u, col_verbose = col_verbose, testflag = testflag)
	current => current%next
	end do
	end subroutine node_write_rec

	@ %def node_write_rec
	@ Binary I/O. Matrix elements are written only for leaf nodes.
	<<State matrices: procedures>>=
	recursive subroutine node_write_raw_rec (node, u)
	type(node_t), intent(in), target :: node
	integer, intent(in) :: u
	logical :: associated_child_first, associated_next
	call node%qn%write_raw (u)
	associated_child_first = associated (node%child_first)
	write (u) associated_child_first
	associated_next = associated (node%next)
	write (u) associated_next
	if (associated_child_first) then
	call node_write_raw_rec (node%child_first, u)
	else
	write (u) node%me_index
	write (u) node%me
	end if
	if (associated_next) then
	call node_write_raw_rec (node%next, u)
	end if
	end subroutine node_write_raw_rec

	recursive subroutine node_read_raw_rec (node, u, parent, iostat)
	type(node_t), intent(out), target :: node
	integer, intent(in) :: u
	type(node_t), intent(in), optional, target :: parent
	integer, intent(out), optional :: iostat
	logical :: associated_child_first, associated_next
	type(node_t), pointer :: child
	call node%qn%read_raw (u, iostat=iostat)
	read (u, iostat=iostat) associated_child_first
	read (u, iostat=iostat) associated_next
	if (present (parent)) node%parent => parent
	if (associated_child_first) then
	allocate (child)
	node%child_first => child
	node%child_last => null ()
	call node_read_raw_rec (child, u, node, iostat=iostat)
	do while (associated (child))
	child%previous => node%child_last
	node%child_last => child
	child => child%next
	end do
	else
	read (u, iostat=iostat) node%me_index
	read (u, iostat=iostat) node%me
	end if
	if (associated_next) then
	allocate (node%next)
	call node_read_raw_rec (node%next, u, parent, iostat=iostat)
	end if
	end subroutine node_read_raw_rec

	@ %def node_write_raw
	@
	\subsection{State matrix}
	\subsubsection{Definition}
	The quantum state object is a container that keeps and hides the root
	node. For direct accessibility of values, they are stored
	in a separate array. The leaf nodes of the quantum-number tree point to those
	values, once the state matrix is finalized.

	The [[norm]] component is redefined if a common factor is extracted from all
	nodes.
	<<State matrices: public>>=
	public :: state_matrix_t
	<<State matrices: types>>=
	type :: state_matrix_t
	private
	type(node_t), pointer :: root => null ()
	integer :: depth = 0
	integer :: n_matrix_elements = 0
	logical :: leaf_nodes_store_values = .false.
	integer :: n_counters = 0
	complex(default), dimension(:), allocatable :: me
	real(default) :: norm = 1
	integer :: n_sub = -1
	contains
	<<State matrices: state matrix: TBP>>
	end type state_matrix_t

	@ %def state_matrix_t
	@ This initializer allocates the root node but does not fill
	anything. We declare whether values are stored within the nodes
	during state-matrix construction, and how many counters should be
	maintained (default: none).
	<<State matrices: state matrix: TBP>>=
	procedure :: init => state_matrix_init
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_init (state, store_values, n_counters)
	class(state_matrix_t), intent(out) :: state
	logical, intent(in), optional :: store_values
	integer, intent(in), optional :: n_counters
	end subroutine state_matrix_init
	<<State matrices: procedures>>=
	module subroutine state_matrix_init (state, store_values, n_counters)
	class(state_matrix_t), intent(out) :: state
	logical, intent(in), optional :: store_values
	integer, intent(in), optional :: n_counters
	allocate (state%root)
	if (present (store_values)) &
	state%leaf_nodes_store_values = store_values
	if (present (n_counters)) state%n_counters = n_counters
	end subroutine state_matrix_init

	@ %def state_matrix_init
	@ This recursively deletes all children of the root node, restoring
	the initial state. The matrix element array is not finalized, since
	it does not contain physical entries, just pointers.
	<<State matrices: state matrix: TBP>>=
	procedure :: final => state_matrix_final
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_final (state)
	class(state_matrix_t), intent(inout) :: state
	end subroutine state_matrix_final
	<<State matrices: procedures>>=
	module subroutine state_matrix_final (state)
	class(state_matrix_t), intent(inout) :: state
	if (allocated (state%me)) deallocate (state%me)
	if (associated (state%root)) call node_delete (state%root)
	state%depth = 0
	state%n_matrix_elements = 0
	end subroutine state_matrix_final

	@ %def state_matrix_final
	@ Output: Present the tree as a nested list with appropriate
	indentation.
	<<State matrices: state matrix: TBP>>=
	procedure :: write => state_matrix_write
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_write (state, unit, write_value_list, &
	verbose, col_verbose, testflag)
	class(state_matrix_t), intent(in) :: state
	logical, intent(in), optional :: write_value_list, verbose, col_verbose
	logical, intent(in), optional :: testflag
	integer, intent(in), optional :: unit
	end subroutine state_matrix_write
	<<State matrices: procedures>>=
	module subroutine state_matrix_write (state, unit, write_value_list, &
	verbose, col_verbose, testflag)
	class(state_matrix_t), intent(in) :: state
	logical, intent(in), optional :: write_value_list, verbose, col_verbose
	logical, intent(in), optional :: testflag
	integer, intent(in), optional :: unit
	complex(default) :: me_dum
	character(len=7) :: fmt
	integer :: u
	integer :: i
	call pac_fmt (fmt, FMT_19, FMT_17, testflag)
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A," // fmt // ")") "State matrix: norm = ", state%norm
	if (associated (state%root)) then
	if (allocated (state%me)) then
	call node_write_rec (state%root, state%me, verbose = verbose, &
	indent = 1, unit = u, col_verbose = col_verbose, &
	testflag = testflag)
	else
	call node_write_rec (state%root, verbose = verbose, indent = 1, &
	unit = u, col_verbose = col_verbose, testflag = testflag)
	end if
	end if
	if (present (write_value_list)) then
	if (write_value_list .and. allocated (state%me)) then
	do i = 1, size (state%me)
	write (u, "(1x,I0,A)", advance="no") i, ":"
	me_dum = state%me(i)
	if (real(state%me(i)) == -real(state%me(i))) then
	me_dum = &
	cmplx (0._default, aimag(me_dum), kind=default)
	end if
	if (aimag(me_dum) == -aimag(me_dum)) then
	me_dum = &
	cmplx (real(me_dum), 0._default, kind=default)
	end if
	write (u, "('('," // fmt // ",','," // fmt // &
	",')')") me_dum
	end do
	end if
	end if
	end subroutine state_matrix_write

	@ %def state_matrix_write
	@ Binary I/O. The auxiliary matrix-element array is not written, but
	reconstructed after reading the tree.

	Note: To be checked. Might be broken, don't use (unless trivial).
	<<State matrices: state matrix: TBP>>=
	procedure :: write_raw => state_matrix_write_raw
	procedure :: read_raw => state_matrix_read_raw
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_write_raw (state, u)
	class(state_matrix_t), intent(in), target :: state
	integer, intent(in) :: u
	end subroutine state_matrix_write_raw
	module subroutine state_matrix_read_raw (state, u, iostat)
	class(state_matrix_t), intent(out) :: state
	integer, intent(in) :: u
	integer, intent(out) :: iostat
	end subroutine state_matrix_read_raw
	<<State matrices: procedures>>=
	module subroutine state_matrix_write_raw (state, u)
	class(state_matrix_t), intent(in), target :: state
	integer, intent(in) :: u
	logical :: is_defined
	integer :: depth, j
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	is_defined = state%is_defined ()
	write (u) is_defined
	if (is_defined) then
	write (u) state%get_norm ()
	write (u) state%get_n_leaves ()
	depth = state%get_depth ()
	write (u) depth
	allocate (qn (depth))
	call it%init (state)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	do j = 1, depth
	call qn(j)%write_raw (u)
	end do
	write (u) it%get_me_index ()
	write (u) it%get_matrix_element ()
	call it%advance ()
	end do
	end if
	end subroutine state_matrix_write_raw

	module subroutine state_matrix_read_raw (state, u, iostat)
	class(state_matrix_t), intent(out) :: state
	integer, intent(in) :: u
	integer, intent(out) :: iostat
	logical :: is_defined
	real(default) :: norm
	integer :: n_leaves, depth, i, j
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: me_index
	complex(default) :: me
	read (u, iostat=iostat) is_defined
	if (iostat /= 0) goto 1
	if (is_defined) then
	call state%init (store_values = .true.)
	read (u, iostat=iostat) norm
	if (iostat /= 0) goto 1
	call state_matrix_set_norm (state, norm)
	read (u) n_leaves
	if (iostat /= 0) goto 1
	read (u) depth
	if (iostat /= 0) goto 1
	allocate (qn (depth))
	do i = 1, n_leaves
	do j = 1, depth
	call qn(j)%read_raw (u, iostat=iostat)
	if (iostat /= 0) goto 1
	end do
	read (u, iostat=iostat) me_index
	if (iostat /= 0) goto 1
	read (u, iostat=iostat) me
	if (iostat /= 0) goto 1
	call state%add_state (qn, index = me_index, value = me)
	end do
	call state_matrix_freeze (state)
	end if
	return

	! Clean up on error
	1 continue
	call state%final ()
	end subroutine state_matrix_read_raw

	@ %def state_matrix_write_raw state_matrix_read_raw
	@ Assign a model pointer to all flavor entries. This will become
	necessary when we have read a state matrix from file.
	<<State matrices: state matrix: TBP>>=
	procedure :: set_model => state_matrix_set_model
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_set_model (state, model)
	class(state_matrix_t), intent(inout), target :: state
	class(model_data_t), intent(in), target :: model
	end subroutine state_matrix_set_model
	<<State matrices: procedures>>=
	module subroutine state_matrix_set_model (state, model)
	class(state_matrix_t), intent(inout), target :: state
	class(model_data_t), intent(in), target :: model
	type(state_iterator_t) :: it
	call it%init (state)
	do while (it%is_valid ())
	call it%set_model (model)
	call it%advance ()
	end do
	end subroutine state_matrix_set_model

	@ %def state_matrix_set_model
	@ Iterate over [[state]], get the quantum numbers array [[qn]] for each iteration, and tag
	all array elements of [[qn]] with the indizes given by [[tag]] as part of the hard interaction.
	Then add them to [[tagged_state]] and return it. If no [[tag]] is given, tag all [[qn]] as
	part of the hard process.
	<<State matrices: state matrix: TBP>>=
	procedure :: tag_hard_process => state_matrix_tag_hard_process
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_tag_hard_process (state, tagged_state, tag)
	class(state_matrix_t), intent(in), target :: state
	type(state_matrix_t), intent(out) :: tagged_state
	integer, dimension(:), intent(in), optional :: tag
	end subroutine state_matrix_tag_hard_process
	<<State matrices: procedures>>=
	module subroutine state_matrix_tag_hard_process (state, tagged_state, tag)
	class(state_matrix_t), intent(in), target :: state
	type(state_matrix_t), intent(out) :: tagged_state
	integer, dimension(:), intent(in), optional :: tag
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	complex(default) :: value
	integer :: i
	call tagged_state%init (store_values = .true.)
	call it%init (state)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	value = it%get_matrix_element ()
	if (present (tag)) then
	do i = 1, size (tag)
	call qn(tag(i))%tag_hard_process ()
	end do
	else
	call qn%tag_hard_process ()
	end if
	call tagged_state%add_state (qn, index = it%get_me_index (), value = value)
	call it%advance ()
	end do
	call tagged_state%freeze ()
	end subroutine state_matrix_tag_hard_process

	@ %def state_matrix_tag_hard_process
	\subsubsection{Properties of the quantum state}
	A state is defined if its root is allocated:
	<<State matrices: state matrix: TBP>>=
	procedure :: is_defined => state_matrix_is_defined
	<<State matrices: sub interfaces>>=
	elemental module function state_matrix_is_defined (state) result (defined)
	logical :: defined
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_is_defined
	<<State matrices: procedures>>=
	elemental module function state_matrix_is_defined (state) result (defined)
	logical :: defined
	class(state_matrix_t), intent(in) :: state
	defined = associated (state%root)
	end function state_matrix_is_defined

	@ %def state_matrix_is_defined
	@ A state is empty if its depth is zero:
	<<State matrices: state matrix: TBP>>=
	procedure :: is_empty => state_matrix_is_empty
	<<State matrices: sub interfaces>>=
	elemental module function state_matrix_is_empty (state) result (flag)
	logical :: flag
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_is_empty
	<<State matrices: procedures>>=
	elemental module function state_matrix_is_empty (state) result (flag)
	logical :: flag
	class(state_matrix_t), intent(in) :: state
	flag = state%depth == 0
	end function state_matrix_is_empty

	@ %def state_matrix_is_empty
	@ Return the number of matrix-element values.
	<<State matrices: state matrix: TBP>>=
	generic :: get_n_matrix_elements => get_n_matrix_elements_all, get_n_matrix_elements_mask
	procedure :: get_n_matrix_elements_all => state_matrix_get_n_matrix_elements_all
	procedure :: get_n_matrix_elements_mask => state_matrix_get_n_matrix_elements_mask
	<<State matrices: sub interfaces>>=
	pure module function state_matrix_get_n_matrix_elements_all (state) result (n)
	integer :: n
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_get_n_matrix_elements_all
	<<State matrices: procedures>>=
	pure module function state_matrix_get_n_matrix_elements_all (state) result (n)
	integer :: n
	class(state_matrix_t), intent(in) :: state
	n = state%n_matrix_elements
	end function state_matrix_get_n_matrix_elements_all

	@ %def state_matrix_get_n_matrix_elements_all
	@
	<<State matrices: sub interfaces>>=
	module function state_matrix_get_n_matrix_elements_mask (state, qn_mask) result (n)
	integer :: n
	class(state_matrix_t), intent(in) :: state
	type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask
	end function state_matrix_get_n_matrix_elements_mask
	<<State matrices: procedures>>=
	module function state_matrix_get_n_matrix_elements_mask (state, qn_mask) result (n)
	integer :: n
	class(state_matrix_t), intent(in) :: state
	type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(size(qn_mask)) :: qn
	type(state_matrix_t) :: state_tmp
	call state_tmp%init ()
	call it%init (state)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	call qn%undefine (qn_mask)
	call state_tmp%add_state (qn)
	call it%advance ()
	end do
	n = state_tmp%n_matrix_elements
	call state_tmp%final ()
	end function state_matrix_get_n_matrix_elements_mask

	@ %def state_matrix_get_n_matrix_elments_mask
	@ Return the size of the [[me]]-array for debugging purposes.
	<<State matrices: state matrix: TBP>>=
	procedure :: get_me_size => state_matrix_get_me_size
	<<State matrices: sub interfaces>>=
	pure module function state_matrix_get_me_size (state) result (n)
	integer :: n
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_get_me_size
	<<State matrices: procedures>>=
	pure module function state_matrix_get_me_size (state) result (n)
	integer :: n
	class(state_matrix_t), intent(in) :: state
	if (allocated (state%me)) then
	n = size (state%me)
	else
	n = 0
	end if
	end function state_matrix_get_me_size

	@ %def state_matrix_get_me_size
	@
	<<State matrices: state matrix: TBP>>=
	procedure :: compute_n_sub => state_matrix_compute_n_sub
	<<State matrices: sub interfaces>>=
	module function state_matrix_compute_n_sub (state) result (n_sub)
	integer :: n_sub
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_compute_n_sub
	<<State matrices: procedures>>=
	module function state_matrix_compute_n_sub (state) result (n_sub)
	integer :: n_sub
	class(state_matrix_t), intent(in) :: state
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(state%depth) :: qn
	integer :: sub, sub_pos
	n_sub = 0
	call it%init (state)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	sub = 0
	sub_pos = qn_array_sub_pos ()
	if (sub_pos > 0) sub = qn(sub_pos)%get_sub ()
	if (sub > n_sub) n_sub = sub
	call it%advance ()
	end do
	contains
	function qn_array_sub_pos () result (pos)
	integer :: pos
	integer :: i
	pos = 0
	do i = 1, state%depth
	if (qn(i)%get_sub () > 0) then
	pos = i
	exit
	end if
	end do
	end function qn_array_sub_pos
	end function state_matrix_compute_n_sub

	@ %def state_matrix_compute_n_sub
	@
	<<State matrices: state matrix: TBP>>=
	procedure :: set_n_sub => state_matrix_set_n_sub
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_set_n_sub (state)
	class(state_matrix_t), intent(inout) :: state
	end subroutine state_matrix_set_n_sub
	<<State matrices: procedures>>=
	module subroutine state_matrix_set_n_sub (state)
	class(state_matrix_t), intent(inout) :: state
	state%n_sub = state%compute_n_sub ()
	end subroutine state_matrix_set_n_sub

	@ %def state_matrix_set_n_sub
	@ Return number of subtractions.
	<<State matrices: state matrix: TBP>>=
	procedure :: get_n_sub => state_matrix_get_n_sub
	<<State matrices: sub interfaces>>=
	module function state_matrix_get_n_sub (state) result (n_sub)
	integer :: n_sub
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_get_n_sub
	<<State matrices: procedures>>=
	module function state_matrix_get_n_sub (state) result (n_sub)
	integer :: n_sub
	class(state_matrix_t), intent(in) :: state
	if (state%n_sub < 0) then
	call msg_bug ("[state_matrix_get_n_sub] number of subtractions not set.")
	end if
	n_sub = state%n_sub
	end function state_matrix_get_n_sub

	@ %def state_matrix_get_n_sub
	@ Return the number of leaves. This can be larger than the number of
	independent matrix elements.
	<<State matrices: state matrix: TBP>>=
	procedure :: get_n_leaves => state_matrix_get_n_leaves
	<<State matrices: sub interfaces>>=
	module function state_matrix_get_n_leaves (state) result (n)
	integer :: n
	class(state_matrix_t), intent(in) :: state
	type(state_iterator_t) :: it
	end function state_matrix_get_n_leaves
	<<State matrices: procedures>>=
	module function state_matrix_get_n_leaves (state) result (n)
	integer :: n
	class(state_matrix_t), intent(in) :: state
	type(state_iterator_t) :: it
	n = 0
	call it%init (state)
	do while (it%is_valid ())
	n = n + 1
	call it%advance ()
	end do
	end function state_matrix_get_n_leaves

	@ %def state_matrix_get_n_leaves
	@ Return the depth:
	<<State matrices: state matrix: TBP>>=
	procedure :: get_depth => state_matrix_get_depth
	<<State matrices: sub interfaces>>=
	pure module function state_matrix_get_depth (state) result (depth)
	integer :: depth
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_get_depth
	<<State matrices: procedures>>=
	pure module function state_matrix_get_depth (state) result (depth)
	integer :: depth
	class(state_matrix_t), intent(in) :: state
	depth = state%depth
	end function state_matrix_get_depth

	@ %def state_matrix_get_depth
	@ Return the norm:
	<<State matrices: state matrix: TBP>>=
	procedure :: get_norm => state_matrix_get_norm
	<<State matrices: sub interfaces>>=
	pure module function state_matrix_get_norm (state) result (norm)
	real(default) :: norm
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_get_norm
	<<State matrices: procedures>>=
	pure module function state_matrix_get_norm (state) result (norm)
	real(default) :: norm
	class(state_matrix_t), intent(in) :: state
	norm = state%norm
	end function state_matrix_get_norm

	@ %def state_matrix_get_norm
	@
	\subsubsection{Retrieving contents}
	Return the quantum number array, using an index. We have to scan the
	state matrix since there is no shortcut.
	<<State matrices: state matrix: TBP>>=
	procedure :: get_quantum_number => &
	state_matrix_get_quantum_number
	<<State matrices: sub interfaces>>=
	module function state_matrix_get_quantum_number (state, i, by_me_index) result (qn)
	class(state_matrix_t), intent(in), target :: state
	integer, intent(in) :: i
	logical, intent(in), optional :: by_me_index
	type(quantum_numbers_t), dimension(state%depth) :: qn
	end function state_matrix_get_quantum_number
	<<State matrices: procedures>>=
	module function state_matrix_get_quantum_number (state, i, by_me_index) result (qn)
	class(state_matrix_t), intent(in), target :: state
	integer, intent(in) :: i
	logical, intent(in), optional :: by_me_index
	logical :: opt_by_me_index
	type(quantum_numbers_t), dimension(state%depth) :: qn
	type(state_iterator_t) :: it
	integer :: k
	opt_by_me_index = .false.
	if (present (by_me_index)) opt_by_me_index = by_me_index
	k = 0
	call it%init (state)
	do while (it%is_valid ())
	if (opt_by_me_index) then
	k = it%get_me_index ()
	else
	k = k + 1
	end if
	if (k == i) then
	qn = it%get_quantum_numbers ()
	exit
	end if
	call it%advance ()
	end do
	end function state_matrix_get_quantum_number

	@ %def state_matrix_get_quantum_number
	<<State matrices: state matrix: TBP>>=
	generic :: get_quantum_numbers => get_quantum_numbers_all, get_quantum_numbers_mask
	procedure :: get_quantum_numbers_all => state_matrix_get_quantum_numbers_all
	procedure :: get_quantum_numbers_mask => state_matrix_get_quantum_numbers_mask
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_get_quantum_numbers_all (state, qn)
	class(state_matrix_t), intent(in), target :: state
	type(quantum_numbers_t), intent(out), dimension(:,:), allocatable :: qn
	end subroutine state_matrix_get_quantum_numbers_all
	<<State matrices: procedures>>=
	module subroutine state_matrix_get_quantum_numbers_all (state, qn)
	class(state_matrix_t), intent(in), target :: state
	type(quantum_numbers_t), intent(out), dimension(:,:), allocatable :: qn
	integer :: i
	allocate (qn (state%get_n_matrix_elements (), &
	state%get_depth()))
	do i = 1, state%get_n_matrix_elements ()
	qn (i, :) = state%get_quantum_number (i)
	end do
	end subroutine state_matrix_get_quantum_numbers_all

	@ %def state_matrix_get_quantum_numbers_all
	@
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_get_quantum_numbers_mask (state, qn_mask, qn)
	class(state_matrix_t), intent(in), target :: state
	type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask
	type(quantum_numbers_t), intent(out), dimension(:,:), allocatable :: qn
	end subroutine state_matrix_get_quantum_numbers_mask
	<<State matrices: procedures>>=
	module subroutine state_matrix_get_quantum_numbers_mask (state, qn_mask, qn)
	class(state_matrix_t), intent(in), target :: state
	type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask
	type(quantum_numbers_t), intent(out), dimension(:,:), allocatable :: qn
	type(quantum_numbers_t), dimension(:), allocatable :: qn_tmp
	type(state_matrix_t) :: state_tmp
	type(state_iterator_t) :: it
	integer :: i, n
	n = state%get_n_matrix_elements (qn_mask)
	allocate (qn (n, state%get_depth ()))
	allocate (qn_tmp (state%get_depth ()))
	call it%init (state)
	call state_tmp%init ()
	do while (it%is_valid ())
	qn_tmp = it%get_quantum_numbers ()
	call qn_tmp%undefine (qn_mask)
	call state_tmp%add_state (qn_tmp)
	call it%advance ()
	end do
	do i = 1, n
	qn (i, :) = state_tmp%get_quantum_number (i)
	end do
	call state_tmp%final ()
	end subroutine state_matrix_get_quantum_numbers_mask

	@ %def state_matrix_get_quantum_numbers_mask
	@
	<<State matrices: state matrix: TBP>>=
	procedure :: get_flavors => state_matrix_get_flavors
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_get_flavors (state, only_elementary, qn_mask, flv)
	class(state_matrix_t), intent(in), target :: state
	logical, intent(in) :: only_elementary
	type(quantum_numbers_mask_t), intent(in), dimension(:), optional :: qn_mask
	integer, intent(out), dimension(:,:), allocatable :: flv
	end subroutine state_matrix_get_flavors
	<<State matrices: procedures>>=
	module subroutine state_matrix_get_flavors (state, only_elementary, qn_mask, flv)
	class(state_matrix_t), intent(in), target :: state
	logical, intent(in) :: only_elementary
	type(quantum_numbers_mask_t), intent(in), dimension(:), optional :: qn_mask
	integer, intent(out), dimension(:,:), allocatable :: flv
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	integer :: i_flv, n_partons
	type(flavor_t), dimension(:), allocatable :: flv_flv
	if (present (qn_mask)) then
	call state%get_quantum_numbers (qn_mask, qn)
	else
	call state%get_quantum_numbers (qn)
	end if
	allocate (flv_flv (size (qn, dim=2)))
	if (only_elementary) then
	flv_flv = qn(1, :)%get_flavor ()
	n_partons = count (is_elementary (flv_flv%get_pdg ()))
	end if
	allocate (flv (n_partons, size (qn, dim=1)))
	associate (n_flv => size (qn, dim=1))
	do i_flv = 1, size (qn, dim=1)
	flv_flv = qn(i_flv, :)%get_flavor ()
	flv(:, i_flv) = pack (flv_flv%get_pdg (), is_elementary(flv_flv%get_pdg()))
	end do
	end associate
	contains
	elemental function is_elementary (pdg)
	logical :: is_elementary
	integer, intent(in) :: pdg
	is_elementary = abs(pdg) /= 2212 .and. abs(pdg) /= 92 .and. abs(pdg) /= 93
	end function is_elementary
	end subroutine state_matrix_get_flavors

	@ %def state_matrix_get_flavors
	@ Return a single matrix element using its index. Works only if the
	shortcut array is allocated.
	<<State matrices: state matrix: TBP>>=
	generic :: get_matrix_element => get_matrix_element_single
	generic :: get_matrix_element => get_matrix_element_array
	procedure :: get_matrix_element_single => &
	state_matrix_get_matrix_element_single
	procedure :: get_matrix_element_array => &
	state_matrix_get_matrix_element_array
	<<State matrices: sub interfaces>>=
	elemental module function state_matrix_get_matrix_element_single (state, i) result (me)
	complex(default) :: me
	class(state_matrix_t), intent(in) :: state
	integer, intent(in) :: i
	end function state_matrix_get_matrix_element_single
	<<State matrices: procedures>>=
	elemental module function state_matrix_get_matrix_element_single (state, i) result (me)
	complex(default) :: me
	class(state_matrix_t), intent(in) :: state
	integer, intent(in) :: i
	if (allocated (state%me)) then
	me = state%me(i)
	else
	me = 0
	end if
	end function state_matrix_get_matrix_element_single

	@ %def state_matrix_get_matrix_element_single
	@
	<<State matrices: sub interfaces>>=
	module function state_matrix_get_matrix_element_array (state) result (me)
	complex(default), dimension(:), allocatable :: me
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_get_matrix_element_array
	<<State matrices: procedures>>=
	module function state_matrix_get_matrix_element_array (state) result (me)
	complex(default), dimension(:), allocatable :: me
	class(state_matrix_t), intent(in) :: state
	if (allocated (state%me)) then
	allocate (me (size (state%me)))
	me = state%me
	else
	me = 0
	end if
	end function state_matrix_get_matrix_element_array

	@ %def state_matrix_get_matrix_element_array
	@ Return the color index with maximum absolute value that is present within
	the state matrix.
	<<State matrices: state matrix: TBP>>=
	procedure :: get_max_color_value => state_matrix_get_max_color_value
	<<State matrices: sub interfaces>>=
	module function state_matrix_get_max_color_value (state) result (cmax)
	integer :: cmax
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_get_max_color_value
	<<State matrices: procedures>>=
	module function state_matrix_get_max_color_value (state) result (cmax)
	integer :: cmax
	class(state_matrix_t), intent(in) :: state
	if (associated (state%root)) then
	cmax = node_get_max_color_value (state%root)
	else
	cmax = 0
	end if
	contains
	recursive function node_get_max_color_value (node) result (cmax)
	integer :: cmax
	type(node_t), intent(in), target :: node
	type(node_t), pointer :: current
	cmax = quantum_numbers_get_max_color_value (node%qn)
	current => node%child_first
	do while (associated (current))
	cmax = max (cmax, node_get_max_color_value (current))
	current => current%next
	end do
	end function node_get_max_color_value
	end function state_matrix_get_max_color_value

	@ %def state_matrix_get_max_color_value
	@
	\subsubsection{Building the quantum state}
	The procedure generates a branch associated to the input array of
	quantum numbers. If the branch exists already, it is used.

	Optionally, we set the matrix-element index, a value (which may be
	added to the previous one), and increment one of the possible
	counters. We may also return the matrix element index of the current
	node.
	<<State matrices: state matrix: TBP>>=
	procedure :: add_state => state_matrix_add_state
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_add_state (state, qn, index, value, &
	sum_values, counter_index, ignore_sub_for_qn, me_index)
	class(state_matrix_t), intent(inout) :: state
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer, intent(in), optional :: index
	complex(default), intent(in), optional :: value
	logical, intent(in), optional :: sum_values
	integer, intent(in), optional :: counter_index
	logical, intent(in), optional :: ignore_sub_for_qn
	integer, intent(out), optional :: me_index
	end subroutine state_matrix_add_state
	<<State matrices: procedures>>=
	module subroutine state_matrix_add_state (state, qn, index, value, &
	sum_values, counter_index, ignore_sub_for_qn, me_index)
	class(state_matrix_t), intent(inout) :: state
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer, intent(in), optional :: index
	complex(default), intent(in), optional :: value
	logical, intent(in), optional :: sum_values
	integer, intent(in), optional :: counter_index
	logical, intent(in), optional :: ignore_sub_for_qn
	integer, intent(out), optional :: me_index
	logical :: set_index, get_index, add
	set_index = present (index)
	get_index = present (me_index)
	add = .false.; if (present (sum_values)) add = sum_values
	if (state%depth == 0) then
	state%depth = size (qn)
	else if (state%depth /= size (qn)) then
	call state%write ()
	call msg_bug ("State matrix: depth mismatch")
	end if
	if (size (qn) > 0) call node_make_branch (state%root, qn)
	contains
	recursive subroutine node_make_branch (parent, qn)
	type(node_t), pointer :: parent
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	type(node_t), pointer :: child
	logical :: match
	match = .false.
	child => parent%child_first
	SCAN_CHILDREN: do while (associated (child))
	if (present (ignore_sub_for_qn)) then
	if (ignore_sub_for_qn) then
	match = quantum_numbers_eq_wo_sub (child%qn, qn(1))
	else
	match = child%qn == qn(1)
	end if
	else
	match = child%qn == qn(1)
	end if
	if (match) exit SCAN_CHILDREN
	child => child%next
	end do SCAN_CHILDREN
	if (.not. match) then
	call node_append_child (parent, child)
	child%qn = qn(1)
	end if
	select case (size (qn))
	case (1)
	if (.not. match) then
	state%n_matrix_elements = state%n_matrix_elements + 1
	child%me_index = state%n_matrix_elements
	end if
	if (set_index) then
	child%me_index = index
	end if
	if (get_index) then
	me_index = child%me_index
	end if
	if (present (counter_index)) then
	if (.not. allocated (child%me_count)) then
	allocate (child%me_count (state%n_counters))
	child%me_count = 0
	end if
	child%me_count(counter_index) = child%me_count(counter_index) + 1
	end if
	if (present (value)) then
	if (add) then
	child%me = child%me + value
	else
	child%me = value
	end if
	end if
	case (2:)
	call node_make_branch (child, qn(2:))
	end select
	end subroutine node_make_branch
	end subroutine state_matrix_add_state

	@ %def state_matrix_add_state
	@ Remove irrelevant flavor/color/helicity labels and the corresponding
	branchings. The masks indicate which particles are affected; the
	masks length should coincide with the depth of the trie (without the
	root node). Recursively scan the whole tree, starting from the leaf
	nodes and working up to the root node. If a mask entry is set for the
	current tree level, scan the children there. For each child within
	that level make a new empty branch where the masked quantum number is
	undefined. Then recursively combine all following children with
	matching quantum number into this new node and move on.
	<<State matrices: state matrix: TBP>>=
	procedure :: collapse => state_matrix_collapse
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_collapse (state, mask)
	class(state_matrix_t), intent(inout) :: state
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	end subroutine state_matrix_collapse
	<<State matrices: procedures>>=
	module subroutine state_matrix_collapse (state, mask)
	class(state_matrix_t), intent(inout) :: state
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	type(state_matrix_t) :: red_state
	if (state%is_defined ()) then
	call state%reduce (mask, red_state)
	call state%final ()
	state = red_state
	end if
	end subroutine state_matrix_collapse

	@ %def state_matrix_collapse
	@ Transform the given state matrix into a reduced state matrix where
	some quantum numbers are removed, as indicated by the mask. The
	procedure creates a new state matrix, so the old one can be deleted
	after this if it is no longer used.

	It is said that the matrix element ordering is lost afterwards. We allow to keep
	the original matrix element index in the new state matrix. If the matrix
	element indices are kept, we do not freeze the state matrix. After reordering
	the matrix element indices by [[state_matrix_reorder_me]], the state matrix can
	be frozen.
	<<State matrices: state matrix: TBP>>=
	procedure :: reduce => state_matrix_reduce
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_reduce (state, mask, red_state, keep_me_index)
	class(state_matrix_t), intent(in), target :: state
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	type(state_matrix_t), intent(out) :: red_state
	logical, optional, intent(in) :: keep_me_index
	end subroutine state_matrix_reduce
	<<State matrices: procedures>>=
	module subroutine state_matrix_reduce (state, mask, red_state, keep_me_index)
	class(state_matrix_t), intent(in), target :: state
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	type(state_matrix_t), intent(out) :: red_state
	logical, optional, intent(in) :: keep_me_index
	logical :: opt_keep_me_index
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(size(mask)) :: qn
	opt_keep_me_index = .false.
	if (present (keep_me_index)) opt_keep_me_index = keep_me_index
	call red_state%init ()
	call it%init (state)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	call qn%undefine (mask)
	if (opt_keep_me_index) then
	call red_state%add_state (qn, index = it%get_me_index ())
	else
	call red_state%add_state (qn)
	end if
	call it%advance ()
	end do
	if (.not. opt_keep_me_index) then
	call red_state%freeze ()
	end if
	end subroutine state_matrix_reduce

	@ %def state_matrix_reduce
	@ Reorder the matrix elements -- not the tree itself. The procedure is necessary
	in case the matrix element indices were kept when reducing over quantum numbers
	and one wants to reintroduce the previous order of the matrix elements.
	<<State matrices: state matrix: TBP>>=
	procedure :: reorder_me => state_matrix_reorder_me
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_reorder_me (state, ordered_state)
	class(state_matrix_t), intent(in), target :: state
	type(state_matrix_t), intent(out) :: ordered_state
	end subroutine state_matrix_reorder_me
	<<State matrices: procedures>>=
	module subroutine state_matrix_reorder_me (state, ordered_state)
	class(state_matrix_t), intent(in), target :: state
	type(state_matrix_t), intent(out) :: ordered_state
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(state%depth) :: qn
	integer, dimension(:), allocatable :: me_index
	integer :: i
	call ordered_state%init ()
	call get_me_index_sorted (state, me_index)
	i = 1; call it%init (state)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	call ordered_state%add_state (qn, index = me_index(i))
	i = i + 1; call it%advance ()
	end do
	call ordered_state%freeze ()
	contains
	subroutine get_me_index_sorted (state, me_index)
	class(state_matrix_t), intent(in), target :: state
	integer, dimension(:), allocatable, intent(out) :: me_index
	type(state_iterator_t) :: it
	integer :: i, j
	integer, dimension(:), allocatable :: me_index_unsorted, me_index_sorted
	associate (n_matrix_elements => state%get_n_matrix_elements ())
	allocate (me_index(n_matrix_elements), source = 0)
	allocate (me_index_sorted(n_matrix_elements), source = 0)
	allocate (me_index_unsorted(n_matrix_elements), source = 0)
	i = 1; call it%init (state)
	do while (it%is_valid ())
	me_index_unsorted(i) = it%get_me_index ()
	i = i + 1
	call it%advance ()
	end do
	me_index_sorted = sort (me_index_unsorted)
	! We do not care about efficiency at this point.
	UNSORTED: do i = 1, n_matrix_elements
	SORTED: do j = 1, n_matrix_elements
	if (me_index_unsorted(i) == me_index_sorted(j)) then
	me_index(i) = j
	cycle UNSORTED
	end if
	end do SORTED
	end do UNSORTED
	end associate
	end subroutine get_me_index_sorted
	end subroutine state_matrix_reorder_me

	@ %def state_matrix_order_by_flavors
	@ Sets all matrix elements whose flavor structure is a duplicate
	of another flavor structure to zero. We need this for the real finite to
	ignore duplicate flavor structures while keeping the indices identical to the
	singular real component.
	When comparing the flavor structures, we take into account permutations of final-
	state particles. To do this properly, we keep only the non-hard flavors and the
	initial-state flavors, i.e. the first two hard flavors fixed.
	<<State matrices: state matrix: TBP>>=
	procedure :: set_duplicate_flv_zero => state_matrix_set_duplicate_flv_zero
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_set_duplicate_flv_zero (state)
	class(state_matrix_t), intent(inout), target :: state
	end subroutine state_matrix_set_duplicate_flv_zero
	<<State matrices: procedures>>=
	module subroutine state_matrix_set_duplicate_flv_zero (state)
	class(state_matrix_t), intent(inout), target :: state
	type(quantum_numbers_t), dimension(state%depth) :: qn
	type(flavor_t) :: flv
	type(state_flv_content_t), allocatable :: state_flv
	logical, dimension(:), allocatable :: hard_mask, sort_mask, duplicate_mask
	integer :: i, j, n_in, n_flvs
	n_flvs = state%get_depth ()
	n_in = 2
	!!! TODO (PS-28-07-21) n_in should not be hard coded to work for decays
	!!! This assumes that the positions of the non-hard flavors are the same for all flavor structures.
	qn = state%get_quantum_number(1)
	allocate (hard_mask(n_flvs))
	do i = 1, n_flvs
	flv = qn(i)%get_flavor()
	hard_mask(i) = flv%is_hard_process ()
	end do
	allocate (sort_mask(n_flvs))
	sort_mask = hard_mask
	j = 0
	do i = 1, n_flvs
	if (j == n_in) exit
	if (sort_mask(i)) then
	sort_mask(i) = .false.
	j = j + 1
	end if
	end do
	allocate (state_flv)
	call state_flv%fill (state, sort_mask)
	call state_flv%find_duplicates (duplicate_mask)
	do i = 1, state%get_n_matrix_elements ()
	if (duplicate_mask(i)) then
	call state%set_matrix_element_single(i, cmplx(zero, zero, default))
	end if
	end do
	end subroutine state_matrix_set_duplicate_flv_zero

	@ %def state_matrix_set_duplicate_flv_zero
	@ This subroutine sets up the matrix-element array. The leaf nodes
	aquire the index values that point to the appropriate matrix-element
	entry.

	We recursively scan the trie. Once we arrive at a leaf node, the
	index is increased and associated to that node. Finally, we allocate
	the matrix-element array with the appropriate size.

	If matrix element values are temporarily stored within the leaf nodes,
	we scan the state again and transfer them to the matrix-element array.
	<<State matrices: state matrix: TBP>>=
	procedure :: freeze => state_matrix_freeze
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_freeze (state)
	class(state_matrix_t), intent(inout), target :: state
	end subroutine state_matrix_freeze
	<<State matrices: procedures>>=
	module subroutine state_matrix_freeze (state)
	class(state_matrix_t), intent(inout), target :: state
	type(state_iterator_t) :: it
	if (associated (state%root)) then
	if (allocated (state%me)) deallocate (state%me)
	allocate (state%me (state%n_matrix_elements))
	state%me = 0
	call state%set_n_sub ()
	end if
	if (state%leaf_nodes_store_values) then
	call it%init (state)
	do while (it%is_valid ())
	state%me(it%get_me_index ()) = it%get_matrix_element ()
	call it%advance ()
	end do
	state%leaf_nodes_store_values = .false.
	end if
	end subroutine state_matrix_freeze

	@ %def state_matrix_freeze
	@
	\subsubsection{Direct access to the value array}
	Several methods for setting a value directly are summarized in this
	generic:
	<<State matrices: state matrix: TBP>>=
	generic :: set_matrix_element => set_matrix_element_qn
	generic :: set_matrix_element => set_matrix_element_all
	generic :: set_matrix_element => set_matrix_element_array
	generic :: set_matrix_element => set_matrix_element_single
	generic :: set_matrix_element => set_matrix_element_clone
	procedure :: set_matrix_element_qn => state_matrix_set_matrix_element_qn
	procedure :: set_matrix_element_all => state_matrix_set_matrix_element_all
	procedure :: set_matrix_element_array => &
	state_matrix_set_matrix_element_array
	procedure :: set_matrix_element_single => &
	state_matrix_set_matrix_element_single
	procedure :: set_matrix_element_clone => &
	state_matrix_set_matrix_element_clone
	@ %def state_matrix_set_matrix_element
	@ Set a value that corresponds to a quantum number array:
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_set_matrix_element_qn (state, qn, value)
	class(state_matrix_t), intent(inout), target :: state
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	complex(default), intent(in) :: value
	end subroutine state_matrix_set_matrix_element_qn
	<<State matrices: procedures>>=
	module subroutine state_matrix_set_matrix_element_qn (state, qn, value)
	class(state_matrix_t), intent(inout), target :: state
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	complex(default), intent(in) :: value
	type(state_iterator_t) :: it
	if (.not. allocated (state%me)) then
	allocate (state%me (size(qn)))
	end if
	call it%init (state)
	call it%go_to_qn (qn)
	call it%set_matrix_element (value)
	end subroutine state_matrix_set_matrix_element_qn

	@ %def state_matrix_set_matrix_element_qn
	@ Set all matrix elements to a single value
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_set_matrix_element_all (state, value)
	class(state_matrix_t), intent(inout) :: state
	complex(default), intent(in) :: value
	end subroutine state_matrix_set_matrix_element_all
	<<State matrices: procedures>>=
	module subroutine state_matrix_set_matrix_element_all (state, value)
	class(state_matrix_t), intent(inout) :: state
	complex(default), intent(in) :: value
	if (.not. allocated (state%me)) then
	allocate (state%me (state%n_matrix_elements))
	end if
	state%me = value
	end subroutine state_matrix_set_matrix_element_all

	@ %def state_matrix_set_matrix_element_all
	@ Set the matrix-element array directly.
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_set_matrix_element_array (state, value, range)
	class(state_matrix_t), intent(inout) :: state
	complex(default), intent(in), dimension(:) :: value
	integer, intent(in), dimension(:), optional :: range
	end subroutine state_matrix_set_matrix_element_array
	<<State matrices: procedures>>=
	module subroutine state_matrix_set_matrix_element_array (state, value, range)
	class(state_matrix_t), intent(inout) :: state
	complex(default), intent(in), dimension(:) :: value
	integer, intent(in), dimension(:), optional :: range
	if (present (range)) then
	state%me(range) = value
	else
	if (.not. allocated (state%me)) &
	allocate (state%me (size (value)))
	state%me(:) = value
	end if
	end subroutine state_matrix_set_matrix_element_array

	@ %def state_matrix_set_matrix_element_array
	@ Set a matrix element at position [[i]] to [[value]].
	<<State matrices: sub interfaces>>=
	pure module subroutine state_matrix_set_matrix_element_single (state, i, value)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	complex(default), intent(in) :: value
	end subroutine state_matrix_set_matrix_element_single
	<<State matrices: procedures>>=
	pure module subroutine state_matrix_set_matrix_element_single (state, i, value)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	complex(default), intent(in) :: value
	if (.not. allocated (state%me)) then
	allocate (state%me (state%n_matrix_elements))
	end if
	state%me(i) = value
	end subroutine state_matrix_set_matrix_element_single

	@ %def state_matrix_set_matrix_element_single
	@ Clone the matrix elements from another (matching) state matrix.
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_set_matrix_element_clone (state, state1)
	class(state_matrix_t), intent(inout) :: state
	type(state_matrix_t), intent(in) :: state1
	end subroutine state_matrix_set_matrix_element_clone
	<<State matrices: procedures>>=
	module subroutine state_matrix_set_matrix_element_clone (state, state1)
	class(state_matrix_t), intent(inout) :: state
	type(state_matrix_t), intent(in) :: state1
	if (.not. allocated (state1%me)) return
	if (.not. allocated (state%me)) allocate (state%me (size (state1%me)))
	state%me = state1%me
	end subroutine state_matrix_set_matrix_element_clone

	@ %def state_matrix_set_matrix_element_clone
	@ Add a value to a matrix element
	<<State matrices: state matrix: TBP>>=
	procedure :: add_to_matrix_element => state_matrix_add_to_matrix_element
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_add_to_matrix_element (state, qn, value, match_only_flavor)
	class(state_matrix_t), intent(inout), target :: state
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	complex(default), intent(in) :: value
	logical, intent(in), optional :: match_only_flavor
	end subroutine state_matrix_add_to_matrix_element
	<<State matrices: procedures>>=
	module subroutine state_matrix_add_to_matrix_element (state, qn, value, match_only_flavor)
	class(state_matrix_t), intent(inout), target :: state
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	complex(default), intent(in) :: value
	logical, intent(in), optional :: match_only_flavor
	type(state_iterator_t) :: it
	call it%init (state)
	call it%go_to_qn (qn, match_only_flavor)
	if (it%is_valid ()) then
	call it%add_to_matrix_element (value)
	else
	call msg_fatal ("Cannot add to matrix element - it%node not allocated")
	end if
	end subroutine state_matrix_add_to_matrix_element

	@ %def state_matrix_add_to_matrix_element
	@
	\subsection{State iterators}
	Accessing the quantum state from outside is best done using a
	specialized iterator, i.e., a pointer to a particular branch of the
	quantum state trie. Technically, the iterator contains a pointer to a
	leaf node, but via parent pointers it allows to access the whole
	branch where the leaf is attached. For quick access, we also keep the
	branch depth (which is assumed to be universal for a quantum state).
	<<State matrices: public>>=
	public :: state_iterator_t
	<<State matrices: types>>=
	type :: state_iterator_t
	private
	integer :: depth = 0
	type(state_matrix_t), pointer :: state => null ()
	type(node_t), pointer :: node => null ()
	contains
	<<State matrices: state iterator: TBP>>
	end type state_iterator_t

	@ %def state_iterator
	@ The initializer: Point at the first branch. Note that this cannot
	be pure, thus not be elemental, because the iterator can be used to
	manipulate data in the state matrix.
	<<State matrices: state iterator: TBP>>=
	procedure :: init => state_iterator_init
	<<State matrices: sub interfaces>>=
	module subroutine state_iterator_init (it, state)
	class(state_iterator_t), intent(out) :: it
	type(state_matrix_t), intent(in), target :: state
	end subroutine state_iterator_init
	<<State matrices: procedures>>=
	module subroutine state_iterator_init (it, state)
	class(state_iterator_t), intent(out) :: it
	type(state_matrix_t), intent(in), target :: state
	it%state => state
	it%depth = state%depth
	if (state%is_defined ()) then
	it%node => state%root
	do while (associated (it%node%child_first))
	it%node => it%node%child_first
	end do
	else
	it%node => null ()
	end if
	end subroutine state_iterator_init

	@ %def state_iterator_init
	@ Go forward. Recursively programmed: if the next node does not
	exist, go back to the parent node and look at its successor (if
	present), etc.

	There is a possible pitfall in the implementation: If the dummy
	pointer argument to the [[find_next]] routine is used directly, we
	still get the correct result for the iterator, but calling the
	recursion on [[node%parent]] means that we manipulate a parent pointer
	in the original state in addition to the iterator. Making a local
	copy of the pointer avoids this. Using pointer intent would be
	helpful, but we do not yet rely on this F2003 feature.
	<<State matrices: state iterator: TBP>>=
	procedure :: advance => state_iterator_advance
	<<State matrices: sub interfaces>>=
	module subroutine state_iterator_advance (it)
	class(state_iterator_t), intent(inout) :: it
	end subroutine state_iterator_advance
	<<State matrices: procedures>>=
	module subroutine state_iterator_advance (it)
	class(state_iterator_t), intent(inout) :: it
	call find_next (it%node)
	contains
	recursive subroutine find_next (node_in)
	type(node_t), intent(in), target :: node_in
	type(node_t), pointer :: node
	node => node_in
	if (associated (node%next)) then
	node => node%next
	do while (associated (node%child_first))
	node => node%child_first
	end do
	it%node => node
	else if (associated (node%parent)) then
	call find_next (node%parent)
	else
	it%node => null ()
	end if
	end subroutine find_next
	end subroutine state_iterator_advance

	@ %def state_iterator_advance
	@ If all has been scanned, the iterator is at an undefined state.
	Check for this:
	<<State matrices: state iterator: TBP>>=
	procedure :: is_valid => state_iterator_is_valid
	<<State matrices: sub interfaces>>=
	module function state_iterator_is_valid (it) result (defined)
	logical :: defined
	class(state_iterator_t), intent(in) :: it
	end function state_iterator_is_valid
	<<State matrices: procedures>>=
	module function state_iterator_is_valid (it) result (defined)
	logical :: defined
	class(state_iterator_t), intent(in) :: it
	defined = associated (it%node)
	end function state_iterator_is_valid

	@ %def state_iterator_is_valid
	@ Return the matrix-element index that corresponds to the current node
	<<State matrices: state iterator: TBP>>=
	procedure :: get_me_index => state_iterator_get_me_index
	<<State matrices: sub interfaces>>=
	module function state_iterator_get_me_index (it) result (n)
	integer :: n
	class(state_iterator_t), intent(in) :: it
	end function state_iterator_get_me_index
	<<State matrices: procedures>>=
	module function state_iterator_get_me_index (it) result (n)
	integer :: n
	class(state_iterator_t), intent(in) :: it
	n = it%node%me_index
	end function state_iterator_get_me_index

	@ %def state_iterator_get_me_index
	@ Return the number of times this quantum-number state has been added
	(noting that it is physically inserted only the first time). Note
	that for each state, there is an array of counters.
	<<State matrices: state iterator: TBP>>=
	procedure :: get_me_count => state_iterator_get_me_count
	<<State matrices: sub interfaces>>=
	module function state_iterator_get_me_count (it) result (n)
	integer, dimension(:), allocatable :: n
	class(state_iterator_t), intent(in) :: it
	end function state_iterator_get_me_count
	<<State matrices: procedures>>=
	module function state_iterator_get_me_count (it) result (n)
	integer, dimension(:), allocatable :: n
	class(state_iterator_t), intent(in) :: it
	if (allocated (it%node%me_count)) then
	allocate (n (size (it%node%me_count)))
	n = it%node%me_count
	else
	allocate (n (0))
	end if
	end function state_iterator_get_me_count

	@ %def state_iterator_get_me_count
	@
	<<State matrices: state iterator: TBP>>=
	procedure :: get_depth => state_iterator_get_depth
	<<State matrices: sub interfaces>>=
	pure module function state_iterator_get_depth (state_iterator) result (depth)
	integer :: depth
	class(state_iterator_t), intent(in) :: state_iterator
	end function state_iterator_get_depth
	<<State matrices: procedures>>=
	pure module function state_iterator_get_depth (state_iterator) result (depth)
	integer :: depth
	class(state_iterator_t), intent(in) :: state_iterator
	depth = state_iterator%depth
	end function state_iterator_get_depth

	@ %def state_iterator_get_depth
	@ Proceed to the state associated with the quantum numbers [[qn]].
	<<State matrices: state iterator: TBP>>=
	procedure :: go_to_qn => state_iterator_go_to_qn
	<<State matrices: sub interfaces>>=
	module subroutine state_iterator_go_to_qn (it, qn, match_only_flavor)
	class(state_iterator_t), intent(inout) :: it
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	logical, intent(in), optional :: match_only_flavor
	end subroutine state_iterator_go_to_qn
	<<State matrices: procedures>>=
	module subroutine state_iterator_go_to_qn (it, qn, match_only_flavor)
	class(state_iterator_t), intent(inout) :: it
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	logical, intent(in), optional :: match_only_flavor
	type(quantum_numbers_t), dimension(:), allocatable :: qn_hard, qn_tmp
	logical :: match_flv
	match_flv = .false.; if (present (match_only_flavor)) match_flv = .true.
	do while (it%is_valid ())
	if (match_flv) then
	qn_tmp = it%get_quantum_numbers ()
	qn_hard = pack (qn_tmp, qn_tmp%are_hard_process ())
	if (all (qn .fmatch. qn_hard)) then
	return
	else
	call it%advance ()
	end if
	else
	if (all (qn == it%get_quantum_numbers ())) then
	return
	else
	call it%advance ()
	end if
	end if
	end do
	end subroutine state_iterator_go_to_qn

	@ %def state_iterator_go_to_qn
	@ Use the iterator to retrieve quantum-number information:
	<<State matrices: state iterator: TBP>>=
	generic :: get_quantum_numbers => get_qn_multi, get_qn_slice, &
	get_qn_range, get_qn_single
	generic :: get_flavor => get_flv_multi, get_flv_slice, &
	get_flv_range, get_flv_single
	generic :: get_color => get_col_multi, get_col_slice, &
	get_col_range, get_col_single
	generic :: get_helicity => get_hel_multi, get_hel_slice, &
	get_hel_range, get_hel_single
	<<State matrices: state iterator: TBP>>=
	procedure :: get_qn_multi => state_iterator_get_qn_multi
	procedure :: get_qn_slice => state_iterator_get_qn_slice
	procedure :: get_qn_range => state_iterator_get_qn_range
	procedure :: get_qn_single => state_iterator_get_qn_single
	procedure :: get_flv_multi => state_iterator_get_flv_multi
	procedure :: get_flv_slice => state_iterator_get_flv_slice
	procedure :: get_flv_range => state_iterator_get_flv_range
	procedure :: get_flv_single => state_iterator_get_flv_single
	procedure :: get_col_multi => state_iterator_get_col_multi
	procedure :: get_col_slice => state_iterator_get_col_slice
	procedure :: get_col_range => state_iterator_get_col_range
	procedure :: get_col_single => state_iterator_get_col_single
	procedure :: get_hel_multi => state_iterator_get_hel_multi
	procedure :: get_hel_slice => state_iterator_get_hel_slice
	procedure :: get_hel_range => state_iterator_get_hel_range
	procedure :: get_hel_single => state_iterator_get_hel_single
	@ These versions return the whole quantum number array
	<<State matrices: sub interfaces>>=
	module function state_iterator_get_qn_multi (it) result (qn)
	class(state_iterator_t), intent(in) :: it
	type(quantum_numbers_t), dimension(it%depth) :: qn
	end function state_iterator_get_qn_multi
	module function state_iterator_get_flv_multi (it) result (flv)
	class(state_iterator_t), intent(in) :: it
	type(flavor_t), dimension(it%depth) :: flv
	end function state_iterator_get_flv_multi
	module function state_iterator_get_col_multi (it) result (col)
	class(state_iterator_t), intent(in) :: it
	type(color_t), dimension(it%depth) :: col
	end function state_iterator_get_col_multi
	module function state_iterator_get_hel_multi (it) result (hel)
	class(state_iterator_t), intent(in) :: it
	type(helicity_t), dimension(it%depth) :: hel
	end function state_iterator_get_hel_multi
	<<State matrices: procedures>>=
	module function state_iterator_get_qn_multi (it) result (qn)
	class(state_iterator_t), intent(in) :: it
	type(quantum_numbers_t), dimension(it%depth) :: qn
	type(node_t), pointer :: node
	integer :: i
	node => it%node
	do i = it%depth, 1, -1
	qn(i) = node%qn
	node => node%parent
	end do
	end function state_iterator_get_qn_multi

	module function state_iterator_get_flv_multi (it) result (flv)
	class(state_iterator_t), intent(in) :: it
	type(flavor_t), dimension(it%depth) :: flv
	flv = quantum_numbers_get_flavor &
	(it%get_quantum_numbers ())
	end function state_iterator_get_flv_multi

	module function state_iterator_get_col_multi (it) result (col)
	class(state_iterator_t), intent(in) :: it
	type(color_t), dimension(it%depth) :: col
	col = quantum_numbers_get_color &
	(it%get_quantum_numbers ())
	end function state_iterator_get_col_multi

	module function state_iterator_get_hel_multi (it) result (hel)
	class(state_iterator_t), intent(in) :: it
	type(helicity_t), dimension(it%depth) :: hel
	hel = quantum_numbers_get_helicity &
	(it%get_quantum_numbers ())
	end function state_iterator_get_hel_multi

	@ An array slice (derived from the above).
	<<State matrices: sub interfaces>>=
	module function state_iterator_get_qn_slice (it, index) result (qn)
	class(state_iterator_t), intent(in) :: it
	integer, dimension(:), intent(in) :: index
	type(quantum_numbers_t), dimension(size(index)) :: qn
	end function state_iterator_get_qn_slice
	module function state_iterator_get_flv_slice (it, index) result (flv)
	class(state_iterator_t), intent(in) :: it
	integer, dimension(:), intent(in) :: index
	type(flavor_t), dimension(size(index)) :: flv
	end function state_iterator_get_flv_slice
	module function state_iterator_get_col_slice (it, index) result (col)
	class(state_iterator_t), intent(in) :: it
	integer, dimension(:), intent(in) :: index
	type(color_t), dimension(size(index)) :: col
	end function state_iterator_get_col_slice
	module function state_iterator_get_hel_slice (it, index) result (hel)
	class(state_iterator_t), intent(in) :: it
	integer, dimension(:), intent(in) :: index
	type(helicity_t), dimension(size(index)) :: hel
	end function state_iterator_get_hel_slice
	<<State matrices: procedures>>=
	module function state_iterator_get_qn_slice (it, index) result (qn)
	class(state_iterator_t), intent(in) :: it
	integer, dimension(:), intent(in) :: index
	type(quantum_numbers_t), dimension(size(index)) :: qn
	type(quantum_numbers_t), dimension(it%depth) :: qn_tmp
	qn_tmp = state_iterator_get_qn_multi (it)
	qn = qn_tmp(index)
	end function state_iterator_get_qn_slice

	module function state_iterator_get_flv_slice (it, index) result (flv)
	class(state_iterator_t), intent(in) :: it
	integer, dimension(:), intent(in) :: index
	type(flavor_t), dimension(size(index)) :: flv
	flv = quantum_numbers_get_flavor &
	(it%get_quantum_numbers (index))
	end function state_iterator_get_flv_slice

	module function state_iterator_get_col_slice (it, index) result (col)
	class(state_iterator_t), intent(in) :: it
	integer, dimension(:), intent(in) :: index
	type(color_t), dimension(size(index)) :: col
	col = quantum_numbers_get_color &
	(it%get_quantum_numbers (index))
	end function state_iterator_get_col_slice

	module function state_iterator_get_hel_slice (it, index) result (hel)
	class(state_iterator_t), intent(in) :: it
	integer, dimension(:), intent(in) :: index
	type(helicity_t), dimension(size(index)) :: hel
	hel = quantum_numbers_get_helicity &
	(it%get_quantum_numbers (index))
	end function state_iterator_get_hel_slice

	@ An array range (implemented directly).
	<<State matrices: sub interfaces>>=
	module function state_iterator_get_qn_range (it, k1, k2) result (qn)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k1, k2
	type(quantum_numbers_t), dimension(k2-k1+1) :: qn
	end function state_iterator_get_qn_range
	module function state_iterator_get_flv_range (it, k1, k2) result (flv)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k1, k2
	type(flavor_t), dimension(k2-k1+1) :: flv
	end function state_iterator_get_flv_range
	module function state_iterator_get_col_range (it, k1, k2) result (col)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k1, k2
	type(color_t), dimension(k2-k1+1) :: col
	end function state_iterator_get_col_range
	module function state_iterator_get_hel_range (it, k1, k2) result (hel)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k1, k2
	type(helicity_t), dimension(k2-k1+1) :: hel
	end function state_iterator_get_hel_range
	<<State matrices: procedures>>=
	module function state_iterator_get_qn_range (it, k1, k2) result (qn)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k1, k2
	type(quantum_numbers_t), dimension(k2-k1+1) :: qn
	type(node_t), pointer :: node
	integer :: i
	node => it%node
	SCAN: do i = it%depth, 1, -1
	if (k1 <= i .and. i <= k2) then
	qn(i-k1+1) = node%qn
	else
	node => node%parent
	end if
	end do SCAN
	end function state_iterator_get_qn_range

	module function state_iterator_get_flv_range (it, k1, k2) result (flv)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k1, k2
	type(flavor_t), dimension(k2-k1+1) :: flv
	flv = quantum_numbers_get_flavor &
	(it%get_quantum_numbers (k1, k2))
	end function state_iterator_get_flv_range

	module function state_iterator_get_col_range (it, k1, k2) result (col)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k1, k2
	type(color_t), dimension(k2-k1+1) :: col
	col = quantum_numbers_get_color &
	(it%get_quantum_numbers (k1, k2))
	end function state_iterator_get_col_range

	module function state_iterator_get_hel_range (it, k1, k2) result (hel)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k1, k2
	type(helicity_t), dimension(k2-k1+1) :: hel
	hel = quantum_numbers_get_helicity &
	(it%get_quantum_numbers (k1, k2))
	end function state_iterator_get_hel_range

	@ Just a specific single element
	<<State matrices: sub interfaces>>=
	module function state_iterator_get_qn_single (it, k) result (qn)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k
	type(quantum_numbers_t) :: qn
	end function state_iterator_get_qn_single
	module function state_iterator_get_flv_single (it, k) result (flv)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k
	type(flavor_t) :: flv
	end function state_iterator_get_flv_single
	module function state_iterator_get_col_single (it, k) result (col)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k
	type(color_t) :: col
	end function state_iterator_get_col_single
	module function state_iterator_get_hel_single (it, k) result (hel)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k
	type(helicity_t) :: hel
	end function state_iterator_get_hel_single
	<<State matrices: procedures>>=
	module function state_iterator_get_qn_single (it, k) result (qn)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k
	type(quantum_numbers_t) :: qn
	type(node_t), pointer :: node
	integer :: i
	node => it%node
	SCAN: do i = it%depth, 1, -1
	if (i == k) then
	qn = node%qn
	exit SCAN
	else
	node => node%parent
	end if
	end do SCAN
	end function state_iterator_get_qn_single

	module function state_iterator_get_flv_single (it, k) result (flv)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k
	type(flavor_t) :: flv
	flv = quantum_numbers_get_flavor &
	(it%get_quantum_numbers (k))
	end function state_iterator_get_flv_single

	module function state_iterator_get_col_single (it, k) result (col)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k
	type(color_t) :: col
	col = quantum_numbers_get_color &
	(it%get_quantum_numbers (k))
	end function state_iterator_get_col_single

	module function state_iterator_get_hel_single (it, k) result (hel)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k
	type(helicity_t) :: hel
	hel = quantum_numbers_get_helicity &
	(it%get_quantum_numbers (k))
	end function state_iterator_get_hel_single

	@ %def state_iterator_get_quantum_numbers
	@ %def state_iterator_get_flavor
	@ %def state_iterator_get_color
	@ %def state_iterator_get_helicity
	@ Assign a model pointer to the current flavor entries.
	<<State matrices: state iterator: TBP>>=
	procedure :: set_model => state_iterator_set_model
	<<State matrices: sub interfaces>>=
	module subroutine state_iterator_set_model (it, model)
	class(state_iterator_t), intent(inout) :: it
	class(model_data_t), intent(in), target :: model
	end subroutine state_iterator_set_model
	<<State matrices: procedures>>=
	module subroutine state_iterator_set_model (it, model)
	class(state_iterator_t), intent(inout) :: it
	class(model_data_t), intent(in), target :: model
	type(node_t), pointer :: node
	integer :: i
	node => it%node
	do i = it%depth, 1, -1
	call node%qn%set_model (model)
	node => node%parent
	end do
	end subroutine state_iterator_set_model

	@ %def state_iterator_set_model
	@ Modify the hard-interaction tag of the current flavor entries at a specific
	position, in-place.
	<<State matrices: state iterator: TBP>>=
	procedure :: retag_hard_process => state_iterator_retag_hard_process
	<<State matrices: sub interfaces>>=
	module subroutine state_iterator_retag_hard_process (it, i, hard)
	class(state_iterator_t), intent(inout) :: it
	integer, intent(in) :: i
	logical, intent(in) :: hard
	end subroutine state_iterator_retag_hard_process
	<<State matrices: procedures>>=
	module subroutine state_iterator_retag_hard_process (it, i, hard)
	class(state_iterator_t), intent(inout) :: it
	integer, intent(in) :: i
	logical, intent(in) :: hard
	type(node_t), pointer :: node
	integer :: j
	node => it%node
	do j = 1, it%depth-i
	node => node%parent
	end do
	call node%qn%tag_hard_process (hard)
	end subroutine state_iterator_retag_hard_process

	@ %def state_iterator_retag_hard_process
	@ Retrieve the matrix element value associated with the current node.
	<<State matrices: state iterator: TBP>>=
	procedure :: get_matrix_element => state_iterator_get_matrix_element
	<<State matrices: sub interfaces>>=
	module function state_iterator_get_matrix_element (it) result (me)
	complex(default) :: me
	class(state_iterator_t), intent(in) :: it
	end function state_iterator_get_matrix_element
	<<State matrices: procedures>>=
	module function state_iterator_get_matrix_element (it) result (me)
	complex(default) :: me
	class(state_iterator_t), intent(in) :: it
	if (it%state%leaf_nodes_store_values) then
	me = it%node%me
	else if (it%node%me_index /= 0) then
	me = it%state%me(it%node%me_index)
	else
	me = 0
	end if
	end function state_iterator_get_matrix_element

	@ %def state_iterator_get_matrix_element
	@ Set the matrix element value using the state iterator.
	<<State matrices: state iterator: TBP>>=
	procedure :: set_matrix_element => state_iterator_set_matrix_element
	<<State matrices: sub interfaces>>=
	module subroutine state_iterator_set_matrix_element (it, value)
	class(state_iterator_t), intent(inout) :: it
	complex(default), intent(in) :: value
	end subroutine state_iterator_set_matrix_element
	<<State matrices: procedures>>=
	module subroutine state_iterator_set_matrix_element (it, value)
	class(state_iterator_t), intent(inout) :: it
	complex(default), intent(in) :: value
	if (it%node%me_index /= 0) it%state%me(it%node%me_index) = value
	end subroutine state_iterator_set_matrix_element

	@ %def state_iterator_set_matrix_element
	@
	<<State matrices: state iterator: TBP>>=
	procedure :: add_to_matrix_element => state_iterator_add_to_matrix_element
	<<State matrices: sub interfaces>>=
	module subroutine state_iterator_add_to_matrix_element (it, value)
	class(state_iterator_t), intent(inout) :: it
	complex(default), intent(in) :: value
	end subroutine state_iterator_add_to_matrix_element
	<<State matrices: procedures>>=
	module subroutine state_iterator_add_to_matrix_element (it, value)
	class(state_iterator_t), intent(inout) :: it
	complex(default), intent(in) :: value
	if (it%node%me_index /= 0) &
	it%state%me(it%node%me_index) = it%state%me(it%node%me_index) + value
	end subroutine state_iterator_add_to_matrix_element

	@ %def state_iterator_add_to_matrix_element
	@
	\subsection{Operations on quantum states}
	Return a deep copy of a state matrix.
	<<State matrices: public>>=
	public :: assignment(=)
	<<State matrices: interfaces>>=
	interface assignment(=)
	module procedure state_matrix_assign
	end interface

	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_assign (state_out, state_in)
	type(state_matrix_t), intent(out) :: state_out
	type(state_matrix_t), intent(in), target :: state_in
	end subroutine state_matrix_assign
	<<State matrices: procedures>>=
	module subroutine state_matrix_assign (state_out, state_in)
	type(state_matrix_t), intent(out) :: state_out
	type(state_matrix_t), intent(in), target :: state_in
	type(state_iterator_t) :: it
	if (.not. state_in%is_defined ()) return
	call state_out%init ()
	call it%init (state_in)
	do while (it%is_valid ())
	call state_out%add_state (it%get_quantum_numbers (), &
	it%get_me_index ())
	call it%advance ()
	end do
	if (allocated (state_in%me)) then
	allocate (state_out%me (size (state_in%me)))
	state_out%me = state_in%me
	end if
	state_out%n_sub = state_in%n_sub
	end subroutine state_matrix_assign

	@ %def state_matrix_assign
	@ Determine the indices of all diagonal matrix elements.
	<<State matrices: state matrix: TBP>>=
	procedure :: get_diagonal_entries => state_matrix_get_diagonal_entries
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_get_diagonal_entries (state, i)
	class(state_matrix_t), intent(in) :: state
	integer, dimension(:), allocatable, intent(out) :: i
	end subroutine state_matrix_get_diagonal_entries
	<<State matrices: procedures>>=
	module subroutine state_matrix_get_diagonal_entries (state, i)
	class(state_matrix_t), intent(in) :: state
	integer, dimension(:), allocatable, intent(out) :: i
	integer, dimension(state%n_matrix_elements) :: tmp
	integer :: n
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	n = 0
	call it%init (state)
	allocate (qn (it%depth))
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	if (all (qn%are_diagonal ())) then
	n = n + 1
	tmp(n) = it%get_me_index ()
	end if
	call it%advance ()
	end do
	allocate (i(n))
	if (n > 0) i = tmp(:n)
	end subroutine state_matrix_get_diagonal_entries

	@ %def state_matrices_get_diagonal_entries
	@ Normalize all matrix elements, i.e., multiply by a common factor.
	Assuming that the factor is nonzero, of course.
	<<State matrices: state matrix: TBP>>=
	procedure :: renormalize => state_matrix_renormalize
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_renormalize (state, factor)
	class(state_matrix_t), intent(inout) :: state
	complex(default), intent(in) :: factor
	end subroutine state_matrix_renormalize
	<<State matrices: procedures>>=
	module subroutine state_matrix_renormalize (state, factor)
	class(state_matrix_t), intent(inout) :: state
	complex(default), intent(in) :: factor
	state%me = state%me * factor
	end subroutine state_matrix_renormalize

	@ %def state_matrix_renormalize
	@ Renormalize the state matrix by its trace, if nonzero. The renormalization
	is reflected in the state-matrix norm.
	<<State matrices: state matrix: TBP>>=
	procedure :: normalize_by_trace => state_matrix_normalize_by_trace
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_normalize_by_trace (state)
	class(state_matrix_t), intent(inout) :: state
	end subroutine state_matrix_normalize_by_trace
	<<State matrices: procedures>>=
	module subroutine state_matrix_normalize_by_trace (state)
	class(state_matrix_t), intent(inout) :: state
	real(default) :: trace
	trace = state%trace ()
	if (trace /= 0) then
	state%me = state%me / trace
	state%norm = state%norm * trace
	end if
	end subroutine state_matrix_normalize_by_trace

	@ %def state_matrix_renormalize_by_trace
	@ Analogous, but renormalize by maximal (absolute) value.
	<<State matrices: state matrix: TBP>>=
	procedure :: normalize_by_max => state_matrix_normalize_by_max
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_normalize_by_max (state)
	class(state_matrix_t), intent(inout) :: state
	end subroutine state_matrix_normalize_by_max
	<<State matrices: procedures>>=
	module subroutine state_matrix_normalize_by_max (state)
	class(state_matrix_t), intent(inout) :: state
	real(default) :: m
	m = maxval (abs (state%me))
	if (m /= 0) then
	state%me = state%me / m
	state%norm = state%norm * m
	end if
	end subroutine state_matrix_normalize_by_max

	@ %def state_matrix_renormalize_by_max
	@ Explicitly set the norm of a state matrix.
	<<State matrices: state matrix: TBP>>=
	procedure :: set_norm => state_matrix_set_norm
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_set_norm (state, norm)
	class(state_matrix_t), intent(inout) :: state
	real(default), intent(in) :: norm
	end subroutine state_matrix_set_norm
	<<State matrices: procedures>>=
	module subroutine state_matrix_set_norm (state, norm)
	class(state_matrix_t), intent(inout) :: state
	real(default), intent(in) :: norm
	state%norm = norm
	end subroutine state_matrix_set_norm

	@ %def state_matrix_set_norm
	@ Return the sum of all matrix element values.
	<<State matrices: state matrix: TBP>>=
	procedure :: sum => state_matrix_sum
	<<State matrices: sub interfaces>>=
	pure module function state_matrix_sum (state) result (value)
	complex(default) :: value
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_sum
	<<State matrices: procedures>>=
	pure module function state_matrix_sum (state) result (value)
	complex(default) :: value
	class(state_matrix_t), intent(in) :: state
	value = sum (state%me)
	end function state_matrix_sum

	@ %def state_matrix_sum
	@ Return the trace of a state matrix, i.e., the sum over all diagonal
	values.

	If [[qn_in]] is provided, only branches that match this
	quantum-numbers array in flavor and helicity are considered. (This mode is
	used for selecting a color state.)
	<<State matrices: state matrix: TBP>>=
	procedure :: trace => state_matrix_trace
	<<State matrices: sub interfaces>>=
	module function state_matrix_trace (state, qn_in) result (trace)
	complex(default) :: trace
	class(state_matrix_t), intent(in), target :: state
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_in
	end function state_matrix_trace
	<<State matrices: procedures>>=
	module function state_matrix_trace (state, qn_in) result (trace)
	complex(default) :: trace
	class(state_matrix_t), intent(in), target :: state
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_in
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	type(state_iterator_t) :: it
	allocate (qn (state%get_depth ()))
	trace = 0
	call it%init (state)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	if (present (qn_in)) then
	if (.not. all (qn .fhmatch. qn_in)) then
	call it%advance (); cycle
	end if
	end if
	if (all (qn%are_diagonal ())) then
	trace = trace + it%get_matrix_element ()
	end if
	call it%advance ()
	end do
	end function state_matrix_trace

	@ %def state_matrix_trace
	@ Append new states which are color-contracted versions of the
	existing states. The matrix element index of each color contraction
	coincides with the index of its origin, so no new matrix elements are
	generated. After this operation, no [[freeze]] must be performed
	anymore.
	<<State matrices: state matrix: TBP>>=
	procedure :: add_color_contractions => state_matrix_add_color_contractions
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_add_color_contractions (state)
	class(state_matrix_t), intent(inout), target :: state
	end subroutine state_matrix_add_color_contractions
	<<State matrices: procedures>>=
	module subroutine state_matrix_add_color_contractions (state)
	class(state_matrix_t), intent(inout), target :: state
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn_con
	integer, dimension(:), allocatable :: me_index
	integer :: depth, n_me, i, j
	depth = state%get_depth ()
	n_me = state%get_n_matrix_elements ()
	allocate (qn (depth, n_me))
	allocate (me_index (n_me))
	i = 0
	call it%init (state)
	do while (it%is_valid ())
	i = i + 1
	qn(:,i) = it%get_quantum_numbers ()
	me_index(i) = it%get_me_index ()
	call it%advance ()
	end do
	do i = 1, n_me
	call quantum_number_array_make_color_contractions (qn(:,i), qn_con)
	do j = 1, size (qn_con, 2)
	call state%add_state (qn_con(:,j), index = me_index(i))
	end do
	end do
	end subroutine state_matrix_add_color_contractions

	@ %def state_matrix_add_color_contractions
	@ This procedure merges two state matrices of equal depth. For each
	quantum number (flavor, color, helicity), we take the entry from the
	first argument where defined, otherwise the second one. (If both are
	defined, we get an off-diagonal matrix.) The resulting
	trie combines the information of the input tries in all possible ways.
	Note that values are ignored, all values in the result are zero.
	<<State matrices: public>>=
	public :: merge_state_matrices
	<<State matrices: sub interfaces>>=
	module subroutine merge_state_matrices (state1, state2, state3)
	type(state_matrix_t), intent(in), target :: state1, state2
	type(state_matrix_t), intent(out) :: state3
	end subroutine merge_state_matrices
	<<State matrices: procedures>>=
	module subroutine merge_state_matrices (state1, state2, state3)
	type(state_matrix_t), intent(in), target :: state1, state2
	type(state_matrix_t), intent(out) :: state3
	type(state_iterator_t) :: it1, it2
	type(quantum_numbers_t), dimension(state1%depth) :: qn1, qn2
	if (state1%depth /= state2%depth) then
	call state1%write ()
	call state2%write ()
	call msg_bug ("State matrices merge impossible: incompatible depths")
	end if
	call state3%init ()
	call it1%init (state1)
	do while (it1%is_valid ())
	qn1 = it1%get_quantum_numbers ()
	call it2%init (state2)
	do while (it2%is_valid ())
	qn2 = it2%get_quantum_numbers ()
	call state3%add_state (qn1 .merge. qn2)
	call it2%advance ()
	end do
	call it1%advance ()
	end do
	call state3%freeze ()
	end subroutine merge_state_matrices

	@ %def merge_state_matrices
	@ Multiply matrix elements from two state matrices. Choose the elements
	as given by the integer index arrays, multiply them and store the sum
	of products in the indicated matrix element. The suffixes mean:
	c=conjugate first factor; f=include weighting factor.

	Note that the [[dot_product]] intrinsic function conjugates its first
	complex argument. This is intended for the [[c]] suffix case, but
	must be reverted for the plain-product case.

	We provide analogous subroutines for just summing over state matrix
	entries. The [[evaluate_sum]] variant includes the state-matrix norm
	in the evaluation, the [[evaluate_me_sum]] takes into account just the
	matrix elements proper.
	<<State matrices: state matrix: TBP>>=
	procedure :: evaluate_product => state_matrix_evaluate_product
	procedure :: evaluate_product_cf => state_matrix_evaluate_product_cf
	procedure :: evaluate_square_c => state_matrix_evaluate_square_c
	procedure :: evaluate_sum => state_matrix_evaluate_sum
	procedure :: evaluate_me_sum => state_matrix_evaluate_me_sum
	<<State matrices: sub interfaces>>=
	pure module subroutine state_matrix_evaluate_product &
	(state, i, state1, state2, index1, index2)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	type(state_matrix_t), intent(in) :: state1, state2
	integer, dimension(:), intent(in) :: index1, index2
	end subroutine state_matrix_evaluate_product
	pure module subroutine state_matrix_evaluate_product_cf &
	(state, i, state1, state2, index1, index2, factor)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	type(state_matrix_t), intent(in) :: state1, state2
	integer, dimension(:), intent(in) :: index1, index2
	complex(default), dimension(:), intent(in) :: factor
	end subroutine state_matrix_evaluate_product_cf
	pure module subroutine state_matrix_evaluate_square_c (state, i, state1, index1)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	type(state_matrix_t), intent(in) :: state1
	integer, dimension(:), intent(in) :: index1
	end subroutine state_matrix_evaluate_square_c
	pure module subroutine state_matrix_evaluate_sum (state, i, state1, index1)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	type(state_matrix_t), intent(in) :: state1
	integer, dimension(:), intent(in) :: index1
	end subroutine state_matrix_evaluate_sum
	pure module subroutine state_matrix_evaluate_me_sum (state, i, state1, index1)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	type(state_matrix_t), intent(in) :: state1
	integer, dimension(:), intent(in) :: index1
	end subroutine state_matrix_evaluate_me_sum
	<<State matrices: procedures>>=
	pure module subroutine state_matrix_evaluate_product &
	(state, i, state1, state2, index1, index2)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	type(state_matrix_t), intent(in) :: state1, state2
	integer, dimension(:), intent(in) :: index1, index2
	state%me(i) = &
	dot_product (conjg (state1%me(index1)), state2%me(index2))
	state%norm = state1%norm * state2%norm
	end subroutine state_matrix_evaluate_product

	pure module subroutine state_matrix_evaluate_product_cf &
	(state, i, state1, state2, index1, index2, factor)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	type(state_matrix_t), intent(in) :: state1, state2
	integer, dimension(:), intent(in) :: index1, index2
	complex(default), dimension(:), intent(in) :: factor
	state%me(i) = &
	dot_product (state1%me(index1), factor * state2%me(index2))
	state%norm = state1%norm * state2%norm
	end subroutine state_matrix_evaluate_product_cf

	pure module subroutine state_matrix_evaluate_square_c (state, i, state1, index1)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	type(state_matrix_t), intent(in) :: state1
	integer, dimension(:), intent(in) :: index1
	state%me(i) = &
	dot_product (state1%me(index1), state1%me(index1))
	state%norm = abs (state1%norm) ** 2
	end subroutine state_matrix_evaluate_square_c

	pure module subroutine state_matrix_evaluate_sum (state, i, state1, index1)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	type(state_matrix_t), intent(in) :: state1
	integer, dimension(:), intent(in) :: index1
	state%me(i) = &
	sum (state1%me(index1)) * state1%norm
	end subroutine state_matrix_evaluate_sum

	pure module subroutine state_matrix_evaluate_me_sum (state, i, state1, index1)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	type(state_matrix_t), intent(in) :: state1
	integer, dimension(:), intent(in) :: index1
	state%me(i) = sum (state1%me(index1))
	end subroutine state_matrix_evaluate_me_sum

	@ %def state_matrix_evaluate_product
	@ %def state_matrix_evaluate_product_cf
	@ %def state_matrix_evaluate_square_c
	@ %def state_matrix_evaluate_sum
	@ %def state_matrix_evaluate_me_sum
	@ Outer product (of states and matrix elements):
	<<State matrices: public>>=
	public :: outer_multiply
	<<State matrices: interfaces>>=
	interface outer_multiply
	module procedure outer_multiply_pair
	module procedure outer_multiply_array
	end interface

	@ %def outer_multiply
	@ This procedure constructs the outer product of two state matrices.
	<<State matrices: sub interfaces>>=
	module subroutine outer_multiply_pair (state1, state2, state3)
	type(state_matrix_t), intent(in), target :: state1, state2
	type(state_matrix_t), intent(out) :: state3
	end subroutine outer_multiply_pair
	<<State matrices: procedures>>=
	module subroutine outer_multiply_pair (state1, state2, state3)
	type(state_matrix_t), intent(in), target :: state1, state2
	type(state_matrix_t), intent(out) :: state3
	type(state_iterator_t) :: it1, it2
	type(quantum_numbers_t), dimension(state1%depth) :: qn1
	type(quantum_numbers_t), dimension(state2%depth) :: qn2
	type(quantum_numbers_t), dimension(state1%depth+state2%depth) :: qn3
	complex(default) :: val1, val2
	call state3%init (store_values = .true.)
	call it1%init (state1)
	do while (it1%is_valid ())
	qn1 = it1%get_quantum_numbers ()
	val1 = it1%get_matrix_element ()
	call it2%init (state2)
	do while (it2%is_valid ())
	qn2 = it2%get_quantum_numbers ()
	val2 = it2%get_matrix_element ()
	qn3(:state1%depth) = qn1
	qn3(state1%depth+1:) = qn2
	call state3%add_state (qn3, value=val1 * val2)
	call it2%advance ()
	end do
	call it1%advance ()
	end do
	call state3%freeze ()
	end subroutine outer_multiply_pair

	@ %def outer_multiply_state_pair
	@ This executes the above routine iteratively for an arbitrary number
	of state matrices.
	<<State matrices: sub interfaces>>=
	module subroutine outer_multiply_array (state_in, state_out)
	type(state_matrix_t), dimension(:), intent(in), target :: state_in
	type(state_matrix_t), intent(out) :: state_out
	end subroutine outer_multiply_array
	<<State matrices: procedures>>=
	module subroutine outer_multiply_array (state_in, state_out)
	type(state_matrix_t), dimension(:), intent(in), target :: state_in
	type(state_matrix_t), intent(out) :: state_out
	type(state_matrix_t), dimension(:), allocatable, target :: state_tmp
	integer :: i, n
	n = size (state_in)
	select case (n)
	case (0)
	call state_out%init ()
	case (1)
	state_out = state_in(1)
	case (2)
	call outer_multiply_pair (state_in(1), state_in(2), state_out)
	case default
	allocate (state_tmp (n-2))
	call outer_multiply_pair (state_in(1), state_in(2), state_tmp(1))
	do i = 2, n - 2
	call outer_multiply_pair (state_tmp(i-1), state_in(i+1), state_tmp(i))
	end do
	call outer_multiply_pair (state_tmp(n-2), state_in(n), state_out)
	do i = 1, size(state_tmp)
	call state_tmp(i)%final ()
	end do
	end select
	end subroutine outer_multiply_array

	@ %def outer_multiply_pair
	@ %def outer_multiply_array
	@
	\subsection{Factorization}
	In physical events, the state matrix is factorized into
	single-particle state matrices. This is essentially a measurement.

	In a simulation, we select one particular branch of the state matrix
	with a probability that is determined by the matrix elements at the
	leaves. (This makes sense only if the state matrix represents a
	squared amplitude.) The selection is based on a (random) value [[x]]
	between 0 and one that is provided as the third argument.

	For flavor and color, we select a unique value for each particle. For
	polarization, we have three options (modes). Option 1 is to drop
	helicity information altogether and sum over all diagonal helicities.
	Option 2 is to select a unique diagonal helicity in the same way as
	flavor and color. Option 3 is, for each particle, to trace over all
	remaining helicities in order to obtain an array of independent
	single-particle helicity matrices.

	Only branches that match the given quantum-number array [[qn_in]], if
	present, are considered. For this array, color is ignored.

	If the optional [[correlated_state]] is provided, it is assigned the
	correlated density matrix for the selected flavor-color branch, so
	multi-particle spin correlations remain available even if they are
	dropped in the single-particle density matrices. This should be
	done by the caller for the choice [[FM_CORRELATED_HELICITY]], which
	otherwise is handled as [[FM_IGNORE_HELICITY]].

	The algorithm is as follows: First, we determine the normalization by
	summing over all diagonal matrix elements. In a second scan, we
	select one of the diagonal matrix elements by a cumulative comparison
	with the normalized random number. In the corresponding quantum
	number array, we undefine the helicity entries. Then, we scan the
	third time. For each branch that matches the selected quantum number
	array (i.e., definite flavor and color, arbitrary helicity), we
	determine its contribution to any of the single-particle state
	matrices. The matrix-element value is added if all other quantum
	numbers are diagonal, while the helicity of the chosen particle may be
	arbitrary; this helicity determines the branch in the single-particle
	state.

	As a result, flavor and color quantum numbers are selected with the
	correct probability. Within this subset of states, each
	single-particle state matrix results from tracing over all other
	particles. Note that the single-particle state matrices are not
	normalized.

	The flag [[ok]] is set to false if the matrix element sum is zero, so
	factorization is not possible. This can happen if an event did not pass
	cuts.
	<<State matrices: parameters>>=
	integer, parameter, public :: FM_IGNORE_HELICITY = 1
	integer, parameter, public :: FM_SELECT_HELICITY = 2
	integer, parameter, public :: FM_FACTOR_HELICITY = 3
	integer, parameter, public :: FM_CORRELATED_HELICITY = 4

	@ %def FM_IGNORE_HELICITY FM_SELECT_HELICITY FM_FACTOR_HELICITY
	@ %def FM_CORRELATED_HELICITY
	<<State matrices: state matrix: TBP>>=
	procedure :: factorize => state_matrix_factorize
	<<State matrices: sub interfaces>>=
	module subroutine state_matrix_factorize &
	(state, mode, x, ok, single_state, correlated_state, qn_in)
	class(state_matrix_t), intent(in), target :: state
	integer, intent(in) :: mode
	real(default), intent(in) :: x
	logical, intent(out) :: ok
	type(state_matrix_t), &
	dimension(:), allocatable, intent(out) :: single_state
	type(state_matrix_t), intent(out), optional :: correlated_state
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_in
	end subroutine state_matrix_factorize
	<<State matrices: procedures>>=
	module subroutine state_matrix_factorize &
	(state, mode, x, ok, single_state, correlated_state, qn_in)
	class(state_matrix_t), intent(in), target :: state
	integer, intent(in) :: mode
	real(default), intent(in) :: x
	logical, intent(out) :: ok
	type(state_matrix_t), &
	dimension(:), allocatable, intent(out) :: single_state
	type(state_matrix_t), intent(out), optional :: correlated_state
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_in
	type(state_iterator_t) :: it
	real(default) :: s, xt
	complex(default) :: value
	integer :: i, depth
	type(quantum_numbers_t), dimension(:), allocatable :: qn, qn1
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
	logical, dimension(:), allocatable :: diagonal
	logical, dimension(:,:), allocatable :: mask
	ok = .true.
	if (x /= 0) then
	xt = x * abs (state%trace (qn_in))
	else
	xt = 0
	end if
	s = 0
	depth = state%get_depth ()
	allocate (qn (depth), qn1 (depth), diagonal (depth))
	call it%init (state)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	if (present (qn_in)) then
	if (.not. all (qn .fhmatch. qn_in)) then
	call it%advance (); cycle
	end if
	end if
	if (all (qn%are_diagonal ())) then
	value = abs (it%get_matrix_element ())
	s = s + value
	if (s > xt) exit
	end if
	call it%advance ()
	end do
	if (.not. it%is_valid ()) then
	if (s == 0) ok = .false.
	call it%init (state)
	end if
	allocate (single_state (depth))
	do i = 1, depth
	call single_state(i)%init (store_values = .true.)
	end do
	if (present (correlated_state)) &
	call correlated_state%init (store_values = .true.)
	qn = it%get_quantum_numbers ()
	select case (mode)
	case (FM_SELECT_HELICITY) ! single branch selected; shortcut
	do i = 1, depth
	call single_state(i)%add_state ([qn(i)], value=value)
	end do
	if (.not. present (correlated_state)) then
	do i = 1, size(single_state)
	call single_state(i)%freeze ()
	end do
	return
	end if
	end select
	allocate (qn_mask (depth))
	call qn_mask%init (.false., .false., .false., .true.)
	call qn%undefine (qn_mask)
	select case (mode)
	case (FM_FACTOR_HELICITY)
	allocate (mask (depth, depth))
	mask = .false.
	forall (i = 1:depth) mask(i,i) = .true.
	end select
	call it%init (state)
	do while (it%is_valid ())
	qn1 = it%get_quantum_numbers ()
	if (all (qn .match. qn1)) then
	diagonal = qn1%are_diagonal ()
	value = it%get_matrix_element ()
	select case (mode)
	case (FM_IGNORE_HELICITY, FM_CORRELATED_HELICITY)
	!!! trace over diagonal states that match qn
	if (all (diagonal)) then
	do i = 1, depth
	call single_state(i)%add_state &
	([qn(i)], value=value, sum_values=.true.)
	end do
	end if
	case (FM_FACTOR_HELICITY) !!! trace over all other particles
	do i = 1, depth
	if (all (diagonal .or. mask(:,i))) then
	call single_state(i)%add_state &
	([qn1(i)], value=value, sum_values=.true.)
	end if
	end do
	end select
	if (present (correlated_state)) &
	call correlated_state%add_state (qn1, value=value)
	end if
	call it%advance ()
	end do
	do i = 1, depth
	call single_state(i)%freeze ()
	end do
	if (present (correlated_state)) &
	call correlated_state%freeze ()
	end subroutine state_matrix_factorize

	@ %def state_matrix_factorize
	@ \subsubsection{Auxiliary functions}
	<<State matrices: state matrix: TBP>>=
	procedure :: get_polarization_density_matrix &
	=> state_matrix_get_polarization_density_matrix
	<<State matrices: sub interfaces>>=
	module function state_matrix_get_polarization_density_matrix &
	(state) result (pol_matrix)
	real(default), dimension(:,:), allocatable :: pol_matrix
	class(state_matrix_t), intent(in) :: state
	end function state_matrix_get_polarization_density_matrix
	<<State matrices: procedures>>=
	module function state_matrix_get_polarization_density_matrix &
	(state) result (pol_matrix)
	real(default), dimension(:,:), allocatable :: pol_matrix
	class(state_matrix_t), intent(in) :: state
	type(node_t), pointer :: current => null ()
	!!! What's the generic way to allocate the matrix?
	allocate (pol_matrix (4,4)); pol_matrix = 0
	if (associated (state%root%child_first)) then
	current => state%root%child_first
	do while (associated (current))
	call current%qn%write ()
	current => current%next
	end do
	else
	call msg_fatal ("Polarization state not allocated!")
	end if
	end function state_matrix_get_polarization_density_matrix

	@ %def state_matrix_get_polarization_density_matrix
	@
	\subsubsection{Quantum-number matching}
	This feature allows us to check whether a given string of PDG values
	matches, in any ordering, any of the flavor combinations that the
	state matrix provides. We will also request the permutation of the
	successful match.

	This type provides an account of the state's flavor content. We store
	all flavor combinations, as [[pdg]] values, in an array, assuming that
	the length is uniform.

	We check only the entries selected by [[mask_match]]. Among those,
	only the entries selected by [[mask_sort]] are sorted and thus matched
	without respecting array element order. The entries that correspond to
	a true value in the associated [[mask]] are sorted. The mapping from
	the original state to the sorted state is given by the index array
	[[map]].
	<<State matrices: public>>=
	public :: state_flv_content_t
	<<State matrices: types>>=
	type :: state_flv_content_t
	private
	integer, dimension(:,:), allocatable :: pdg
	integer, dimension(:,:), allocatable :: map
	logical, dimension(:), allocatable :: mask
	contains
	<<State matrices: state flv content: TBP>>
	end type state_flv_content_t

	@ %def state_matrix_flavor_content
	@ Output (debugging aid).
	<<State matrices: state flv content: TBP>>=
	procedure :: write => state_flv_content_write
	<<State matrices: sub interfaces>>=
	module subroutine state_flv_content_write (state_flv, unit)
	class(state_flv_content_t), intent(in), target :: state_flv
	integer, intent(in), optional :: unit
	end subroutine state_flv_content_write
	<<State matrices: procedures>>=
	module subroutine state_flv_content_write (state_flv, unit)
	class(state_flv_content_t), intent(in), target :: state_flv
	integer, intent(in), optional :: unit
	integer :: u, n, d, i, j
	u = given_output_unit (unit)
	d = size (state_flv%pdg, 1)
	n = size (state_flv%pdg, 2)
	do i = 1, n
	write (u, "(2x,'PDG =')", advance="no")
	do j = 1, d
	write (u, "(1x,I0)", advance="no") state_flv%pdg(j,i)
	end do
	write (u, "(' :: map = (')", advance="no")
	do j = 1, d
	write (u, "(1x,I0)", advance="no") state_flv%map(j,i)
	end do
	write (u, "(' )')")
	end do
	end subroutine state_flv_content_write

	@ %def state_flv_content_write
	@ Initialize with table length and mask. Each row of the [[map]]
	array, of length $d$, is initialized with $(0,1,\ldots,d)$.
	<<State matrices: state flv content: TBP>>=
	procedure :: init => state_flv_content_init
	<<State matrices: sub interfaces>>=
	module subroutine state_flv_content_init (state_flv, n, mask)
	class(state_flv_content_t), intent(out) :: state_flv
	integer, intent(in) :: n
	logical, dimension(:), intent(in) :: mask
	end subroutine state_flv_content_init
	<<State matrices: procedures>>=
	module subroutine state_flv_content_init (state_flv, n, mask)
	class(state_flv_content_t), intent(out) :: state_flv
	integer, intent(in) :: n
	logical, dimension(:), intent(in) :: mask
	integer :: d, i
	d = size (mask)
	allocate (state_flv%pdg (d, n), source = 0)
	allocate (state_flv%map (d, n), source = spread ([(i, i = 1, d)], 2, n))
	allocate (state_flv%mask (d), source = mask)
	end subroutine state_flv_content_init

	@ %def state_flv_content_init
	@ Manually fill the entries, one flavor set and mapping at a time.
	<<State matrices: state flv content: TBP>>=
	procedure :: set_entry => state_flv_content_set_entry
	<<State matrices: sub interfaces>>=
	module subroutine state_flv_content_set_entry (state_flv, i, pdg, map)
	class(state_flv_content_t), intent(inout) :: state_flv
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: pdg, map
	end subroutine state_flv_content_set_entry
	<<State matrices: procedures>>=
	module subroutine state_flv_content_set_entry (state_flv, i, pdg, map)
	class(state_flv_content_t), intent(inout) :: state_flv
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: pdg, map
	state_flv%pdg(:,i) = pdg
	where (map /= 0)
	state_flv%map(:,i) = map
	end where
	end subroutine state_flv_content_set_entry

	@ %def state_flv_content_set_entry
	@ Given a state matrix, determine the flavor content. That is, scan
	the state matrix and extract flavor only, build a new state matrix
	from that.
	<<State matrices: state flv content: TBP>>=
	procedure :: fill => state_flv_content_fill
	<<State matrices: sub interfaces>>=
	module subroutine state_flv_content_fill &
	(state_flv, state_full, mask)
	class(state_flv_content_t), intent(out) :: state_flv
	type(state_matrix_t), intent(in), target :: state_full
	logical, dimension(:), intent(in) :: mask
	end subroutine state_flv_content_fill
	<<State matrices: procedures>>=
	module subroutine state_flv_content_fill &
	(state_flv, state_full, mask)
	class(state_flv_content_t), intent(out) :: state_flv
	type(state_matrix_t), intent(in), target :: state_full
	logical, dimension(:), intent(in) :: mask
	type(state_matrix_t), target :: state_tmp
	type(state_iterator_t) :: it
	type(flavor_t), dimension(:), allocatable :: flv
	integer, dimension(:), allocatable :: pdg, pdg_subset
	integer, dimension(:), allocatable :: idx, map_subset, idx_subset, map
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: n, d, c, i
	call state_tmp%init ()
	d = state_full%get_depth ()
	allocate (flv (d), qn (d), pdg (d), idx (d), map (d))
	idx = [(i, i = 1, d)]
	c = count (mask)
	allocate (pdg_subset (c), map_subset (c), idx_subset (c))
	call it%init (state_full)
	do while (it%is_valid ())
	flv = it%get_flavor ()
	call qn%init (flv)
	call state_tmp%add_state (qn)
	call it%advance ()
	end do
	n = state_tmp%get_n_leaves ()
	call state_flv%init (n, mask)
	i = 0
	call it%init (state_tmp)
	do while (it%is_valid ())
	i = i + 1
	flv = it%get_flavor ()
	pdg = flv%get_pdg ()
	idx_subset = pack (idx, mask)
	pdg_subset = pack (pdg, mask)
	map_subset = order_abs (pdg_subset)
	map = unpack (idx_subset (map_subset), mask, idx)
	call state_flv%set_entry (i, &
	unpack (pdg_subset(map_subset), mask, pdg), &
	order (map))
	call it%advance ()
	end do
	call state_tmp%final ()
	end subroutine state_flv_content_fill

	@ %def state_flv_content_fill
	@ Match a given flavor string against the flavor content. We sort the
	input string and check whether it matches any of the stored strings.
	If yes, return the mapping.

	Only PDG entries under the preset mask are sorted before matching. The
	other entries must match exactly (i.e., without reordering). A zero
	entry matches anything. In any case, the length of the PDG string
	must be equal to the length $d$ of the individual flavor-state entries.
	<<State matrices: state flv content: TBP>>=
	procedure :: match => state_flv_content_match
	<<State matrices: sub interfaces>>=
	module subroutine state_flv_content_match (state_flv, pdg, success, map)
	class(state_flv_content_t), intent(in) :: state_flv
	integer, dimension(:), intent(in) :: pdg
	logical, intent(out) :: success
	integer, dimension(:), intent(out) :: map
	end subroutine state_flv_content_match
	<<State matrices: procedures>>=
	module subroutine state_flv_content_match (state_flv, pdg, success, map)
	class(state_flv_content_t), intent(in) :: state_flv
	integer, dimension(:), intent(in) :: pdg
	logical, intent(out) :: success
	integer, dimension(:), intent(out) :: map
	integer, dimension(:), allocatable :: pdg_subset, pdg_sorted, map1, map2
	integer, dimension(:), allocatable :: idx, map_subset, idx_subset
	integer :: i, n, c, d
	c = count (state_flv%mask)
	d = size (state_flv%pdg, 1)
	n = size (state_flv%pdg, 2)
	allocate (idx (d), source = [(i, i = 1, d)])
	allocate (idx_subset (c), pdg_subset (c), map_subset (c))
	allocate (pdg_sorted (d), map1 (d), map2 (d))
	idx_subset = pack (idx, state_flv%mask)
	pdg_subset = pack (pdg, state_flv%mask)
	map_subset = order_abs (pdg_subset)
	pdg_sorted = unpack (pdg_subset(map_subset), state_flv%mask, pdg)
	success = .false.
	do i = 1, n
	if (all (pdg_sorted == state_flv%pdg(:,i) &
	.or. pdg_sorted == 0)) then
	success = .true.
	exit
	end if
	end do
	if (success) then
	map1 = state_flv%map(:,i)
	map2 = unpack (idx_subset(map_subset), state_flv%mask, idx)
	map = map2(map1)
	where (pdg == 0) map = 0
	end if
	end subroutine state_flv_content_match

	@ %def state_flv_content_match
	@ Check if a given PDG code occurs anywhere in the table.
	<<State matrices: state flv content: TBP>>=
	procedure :: contains => state_flv_content_contains
	<<State matrices: sub interfaces>>=
	module function state_flv_content_contains (state_flv, pdg) result (success)
	class(state_flv_content_t), intent(in) :: state_flv
	integer, intent(in) :: pdg
	logical :: success
	end function state_flv_content_contains
	<<State matrices: procedures>>=
	module function state_flv_content_contains (state_flv, pdg) result (success)
	class(state_flv_content_t), intent(in) :: state_flv
	integer, intent(in) :: pdg
	logical :: success
	success = any (state_flv%pdg == pdg)
	end function state_flv_content_contains

	@ %def state_flv_content_contains
	@
	<<State matrices: procedures>>=
	elemental function pacify_complex (c_in) result (c_pac)
	complex(default), intent(in) :: c_in
	complex(default) :: c_pac
	c_pac = c_in
	if (real(c_pac) == -real(c_pac)) then
	c_pac = &
	cmplx (0._default, aimag(c_pac), kind=default)
	end if
	if (aimag(c_pac) == -aimag(c_pac)) then
	c_pac = &
	cmplx (real(c_pac), 0._default, kind=default)
	end if
	end function pacify_complex

	@ %def pacify_complex
	@ Looks for flavor structures that only differ by a permutation
	of the masked flavors.
	The result is returned in form of a mask which is [[.true.]] at the
	positions of a duplicate flavor structure from the second encounter on.
	This routine implements the naive approach: We go through all flavor
	structures and compare each one with each preceeding one. This works
	but is $\mathcal{O}(n^2)$ in the number of flavor structures. Using
	a table to remember which flavor structure has already been encountered,
	if would be possible to find the duplicates in $\mathcal{O}(n)$.
	<<State matrices: state flv content: TBP>>=
	procedure :: find_duplicates => state_flv_content_find_duplicates
	<<State matrices: sub interfaces>>=
	module subroutine state_flv_content_find_duplicates (state_flv, duplicate_mask)
	class(state_flv_content_t), intent(in) :: state_flv
	logical, dimension(:), allocatable, intent(out) :: duplicate_mask
	end subroutine state_flv_content_find_duplicates
	<<State matrices: procedures>>=
	module subroutine state_flv_content_find_duplicates (state_flv, duplicate_mask)
	class(state_flv_content_t), intent(in) :: state_flv
	logical, dimension(:), allocatable, intent(out) :: duplicate_mask
	integer, dimension(:), allocatable :: flvst
	integer :: i1, i2, n_flvsts
	logical :: found_once
	n_flvsts = size (state_flv%pdg, 2)
	allocate (duplicate_mask (n_flvsts))
	duplicate_mask = .false.
	do i1 = 1, n_flvsts
	found_once = .false.
	flvst = state_flv%pdg(:,i1)
	do i2 = 1, i1
	if (all(flvst == state_flv%pdg(:,i2))) then
	if (found_once) then
	duplicate_mask(i1) = .true.
	exit
	else
	found_once = .true.
	end if
	end if
	end do
	end do
	end subroutine state_flv_content_find_duplicates

	@ %def state_flv_content_find_duplicates
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[state_matrices_ut.f90]]>>=
	<<File header>>

	module state_matrices_ut
	use unit_tests
	use state_matrices_uti

	<<Standard module head>>

	<<State matrices: public test>>

	contains

	<<State matrices: test driver>>

	end module state_matrices_ut
	@ %def state_matrices_ut
	@
	<<[[state_matrices_uti.f90]]>>=
	<<File header>>

	module state_matrices_uti

	<<Use kinds>>
	use io_units
	use format_defs, only: FMT_19
	use flavors
	use colors
	use helicities
	use quantum_numbers

	use state_matrices

	<<Standard module head>>

	<<State matrices: test declarations>>

	contains

	<<State matrices: tests>>

	end module state_matrices_uti
	@ %def state_matrices_ut
	@ API: driver for the unit tests below.
	<<State matrices: public test>>=
	public :: state_matrix_test
	<<State matrices: test driver>>=
	subroutine state_matrix_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<State matrices: execute tests>>
	end subroutine state_matrix_test

	@ %def state_matrix_test
	@ Create two quantum states of equal depth and merge them.
	<<State matrices: execute tests>>=
	call test (state_matrix_1, "state_matrix_1", &
	"check merge of quantum states of equal depth", &
	u, results)
	<<State matrices: test declarations>>=
	public :: state_matrix_1
	<<State matrices: tests>>=
	subroutine state_matrix_1 (u)
	integer, intent(in) :: u
	type(state_matrix_t) :: state1, state2, state3
	type(flavor_t), dimension(3) :: flv
	type(color_t), dimension(3) :: col
	type(quantum_numbers_t), dimension(3) :: qn

	write (u, "(A)") "* Test output: state_matrix_1"
	write (u, "(A)") "* Purpose: create and merge two quantum states"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	write (u, "(A)") "* State matrix 1"
	write (u, "(A)")

	call state1%init ()
	call flv%init ([1, 2, 11])
	call qn%init (flv, helicity ([ 1, 1, 1]))
	call state1%add_state (qn)
	call qn%init (flv, helicity ([ 1, 1, 1], [-1, 1, -1]))
	call state1%add_state (qn)
	call state1%freeze ()
	call state1%write (u)

	write (u, "(A)")
	write (u, "(A)") "* State matrix 2"
	write (u, "(A)")

	call state2%init ()
	call col(1)%init ([501])
	call col(2)%init ([-501])
	call col(3)%init ([0])
	call qn%init (col, helicity ([-1, -1, 0]))
	call state2%add_state (qn)
	call col(3)%init ([99])
	call qn%init (col, helicity ([-1, -1, 0]))
	call state2%add_state (qn)
	call state2%freeze ()
	call state2%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Merge the state matrices"
	write (u, "(A)")

	call merge_state_matrices (state1, state2, state3)
	call state3%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Collapse the state matrix"
	write (u, "(A)")

	call state3%collapse (quantum_numbers_mask (.false., .false., &
	[.true.,.false.,.false.]))
	call state3%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"
	write (u, "(A)")

	call state1%final ()
	call state2%final ()
	call state3%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: state_matrix_1"
	write (u, "(A)")

	end subroutine state_matrix_1

	@ %def state_matrix_1
	@ Create a correlated three-particle state matrix and factorize it.
	<<State matrices: execute tests>>=
	call test (state_matrix_2, "state_matrix_2", &
	"check factorizing 3-particle state matrix", &
	u, results)
	<<State matrices: test declarations>>=
	public :: state_matrix_2
	<<State matrices: tests>>=
	subroutine state_matrix_2 (u)
	integer, intent(in) :: u
	type(state_matrix_t) :: state
	type(state_matrix_t), dimension(:), allocatable :: single_state
	type(state_matrix_t) :: correlated_state
	integer :: f, h11, h12, h21, h22, i, mode
	type(flavor_t), dimension(2) :: flv
	type(color_t), dimension(2) :: col
	type(helicity_t), dimension(2) :: hel
	type(quantum_numbers_t), dimension(2) :: qn
	logical :: ok

	write (u, "(A)")
	write (u, "(A)") "* Test output: state_matrix_2"
	write (u, "(A)") "* Purpose: factorize correlated 3-particle state"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call state%init ()
	do f = 1, 2
	do h11 = -1, 1, 2
	do h12 = -1, 1, 2
	do h21 = -1, 1, 2
	do h22 = -1, 1, 2
	call flv%init ([f, -f])
	call col(1)%init ([1])
	call col(2)%init ([-1])
	call hel%init ([h11,h12], [h21, h22])
	call qn%init (flv, col, hel)
	call state%add_state (qn)
	end do
	end do
	end do
	end do
	end do
	call state%freeze ()
	call state%write (u)

	write (u, "(A)")
	write (u, "(A,'('," // FMT_19 // ",','," // FMT_19 // ",')')") &
	"* Trace = ", state%trace ()
	write (u, "(A)")

	do mode = 1, 3
	write (u, "(A)")
	write (u, "(A,I1)") "* Mode = ", mode
	call state%factorize &
	(mode, 0.15_default, ok, single_state, correlated_state)
	do i = 1, size (single_state)
	write (u, "(A)")
	call single_state(i)%write (u)
	write (u, "(A,'('," // FMT_19 // ",','," // FMT_19 // ",')')") &
	"Trace = ", single_state(i)%trace ()
	end do
	write (u, "(A)")
	call correlated_state%write (u)
	write (u, "(A,'('," // FMT_19 // ",','," // FMT_19 // ",')')") &
	"Trace = ", correlated_state%trace ()
	do i = 1, size(single_state)
	call single_state(i)%final ()
	end do
	call correlated_state%final ()
	end do

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call state%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: state_matrix_2"

	end subroutine state_matrix_2

	@ %def state_matrix_2
	@ Create a colored state matrix and add color contractions.
	<<State matrices: execute tests>>=
	call test (state_matrix_3, "state_matrix_3", &
	"check factorizing 3-particle state matrix", &
	u, results)
	<<State matrices: test declarations>>=
	public :: state_matrix_3
	<<State matrices: tests>>=
	subroutine state_matrix_3 (u)
	use physics_defs, only: HADRON_REMNANT_TRIPLET, HADRON_REMNANT_OCTET
	integer, intent(in) :: u
	type(state_matrix_t) :: state
	type(flavor_t), dimension(4) :: flv
	type(color_t), dimension(4) :: col
	type(quantum_numbers_t), dimension(4) :: qn

	write (u, "(A)") "* Test output: state_matrix_3"
	write (u, "(A)") "* Purpose: add color connections to colored state"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call state%init ()
	call flv%init ([ 1, -HADRON_REMNANT_TRIPLET, -1, HADRON_REMNANT_TRIPLET ])
	call col(1)%init ([17])
	call col(2)%init ([-17])
	call col(3)%init ([-19])
	call col(4)%init ([19])
	call qn%init (flv, col)
	call state%add_state (qn)
	call flv%init ([ 1, -HADRON_REMNANT_TRIPLET, 21, HADRON_REMNANT_OCTET ])
	call col(1)%init ([17])
	call col(2)%init ([-17])
	call col(3)%init ([3, -5])
	call col(4)%init ([5, -3])
	call qn%init (flv, col)
	call state%add_state (qn)
	call state%freeze ()

	write (u, "(A)") "* State:"
	write (u, "(A)")

	call state%write (u)
	call state%add_color_contractions ()

	write (u, "(A)") "* State with contractions:"
	write (u, "(A)")

	call state%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call state%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: state_matrx_3"

	end subroutine state_matrix_3

	@ %def state_matrix_3
	@ Create a correlated three-particle state matrix, write it to file
	and read again.
	<<State matrices: execute tests>>=
	call test (state_matrix_4, "state_matrix_4", &
	"check raw I/O", &
	u, results)
	<<State matrices: test declarations>>=
	public :: state_matrix_4
	<<State matrices: tests>>=
	subroutine state_matrix_4 (u)
	integer, intent(in) :: u
	type(state_matrix_t), allocatable :: state
	integer :: f, h11, h12, h21, h22, i
	type(flavor_t), dimension(2) :: flv
	type(color_t), dimension(2) :: col
	type(helicity_t), dimension(2) :: hel
	type(quantum_numbers_t), dimension(2) :: qn
	integer :: unit, iostat

	write (u, "(A)")
	write (u, "(A)") "* Test output: state_matrix_4"
	write (u, "(A)") "* Purpose: raw I/O for correlated 3-particle state"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	allocate (state)

	call state%init ()
	do f = 1, 2
	do h11 = -1, 1, 2
	do h12 = -1, 1, 2
	do h21 = -1, 1, 2
	do h22 = -1, 1, 2
	call flv%init ([f, -f])
	call col(1)%init ([1])
	call col(2)%init ([-1])
	call hel%init ([h11, h12], [h21, h22])
	call qn%init (flv, col, hel)
	call state%add_state (qn)
	end do
	end do
	end do
	end do
	end do
	call state%freeze ()

	call state%set_norm (3._default)
	do i = 1, state%get_n_leaves ()
	call state%set_matrix_element (i, cmplx (2 * i, 2 * i + 1, default))
	end do

	call state%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write to file and read again "
	write (u, "(A)")

	unit = free_unit ()
	open (unit, action="readwrite", form="unformatted", status="scratch")
	call state%write_raw (unit)
	call state%final ()
	deallocate (state)

	allocate(state)
	rewind (unit)
	call state%read_raw (unit, iostat=iostat)
	close (unit)

	call state%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call state%final ()
	deallocate (state)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: state_matrix_4"

	end subroutine state_matrix_4

	@ %def state_matrix_4
	@
	Create a flavor-content object for a given state matrix and match it
	against trial flavor (i.e., PDG) strings.
	<<State matrices: execute tests>>=
	call test (state_matrix_5, "state_matrix_5", &
	"check flavor content", &
	u, results)
	<<State matrices: test declarations>>=
	public :: state_matrix_5
	<<State matrices: tests>>=
	subroutine state_matrix_5 (u)
	integer, intent(in) :: u
	type(state_matrix_t), allocatable, target :: state
	type(state_iterator_t) :: it
	type(state_flv_content_t), allocatable :: state_flv
	type(flavor_t), dimension(4) :: flv1, flv2, flv3, flv4
	type(color_t), dimension(4) :: col1, col2
	type(helicity_t), dimension(4) :: hel1, hel2, hel3
	type(quantum_numbers_t), dimension(4) :: qn
	logical, dimension(4) :: mask

	write (u, "(A)") "* Test output: state_matrix_5"
	write (u, "(A)") "* Purpose: check flavor-content state"
	write (u, "(A)")

	write (u, "(A)") "* Set up arbitrary state matrix"
	write (u, "(A)")

	call flv1%init ([1, 4, 2, 7])
	call flv2%init ([1, 3,-3, 8])
	call flv3%init ([5, 6, 3, 7])
	call flv4%init ([6, 3, 5, 8])
	call hel1%init ([0, 1, -1, 0])
	call hel2%init ([0, 1, 1, 1])
	call hel3%init ([1, 0, 0, 0])
	call col1(1)%init ([0])
	call col1(2)%init ([0])
	call col1(3)%init ([0])
	call col1(4)%init ([0])
	call col2(1)%init ([5, -6])
	call col2(2)%init ([0])
	call col2(3)%init ([6, -5])
	call col2(4)%init ([0])

	allocate (state)
	call state%init ()
	call qn%init (flv1, col1, hel1)
	call state%add_state (qn)
	call qn%init (flv1, col1, hel2)
	call state%add_state (qn)
	call qn%init (flv3, col1, hel3)
	call state%add_state (qn)
	call qn%init (flv4, col1, hel3)
	call state%add_state (qn)
	call qn%init (flv1, col2, hel3)
	call state%add_state (qn)
	call qn%init (flv2, col2, hel2)
	call state%add_state (qn)
	call qn%init (flv2, col2, hel1)
	call state%add_state (qn)
	call qn%init (flv2, col1, hel1)
	call state%add_state (qn)
	call qn%init (flv3, col1, hel1)
	call state%add_state (qn)
	call qn%init (flv3, col2, hel3)
	call state%add_state (qn)
	call qn%init (flv1, col1, hel1)
	call state%add_state (qn)

	write (u, "(A)") "* Quantum number content"
	write (u, "(A)")

	call it%init (state)
	do while (it%is_valid ())
	call quantum_numbers_write (it%get_quantum_numbers (), u)
	write (u, *)
	call it%advance ()
	end do

	write (u, "(A)")
	write (u, "(A)") "* Extract the flavor content"
	write (u, "(A)")

	mask = [.true., .true., .true., .false.]

	allocate (state_flv)
	call state_flv%fill (state, mask)
	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Match trial sets"
	write (u, "(A)")

	call check ([1, 2, 3, 0])
	call check ([1, 4, 2, 0])
	call check ([4, 2, 1, 0])
	call check ([1, 3, -3, 0])
	call check ([1, -3, 3, 0])
	call check ([6, 3, 5, 0])

	write (u, "(A)")
	write (u, "(A)") "* Determine the flavor content with mask"
	write (u, "(A)")

	mask = [.false., .true., .true., .false.]

	call state_flv%fill (state, mask)
	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Match trial sets"
	write (u, "(A)")

	call check ([1, 2, 3, 0])
	call check ([1, 4, 2, 0])
	call check ([4, 2, 1, 0])
	call check ([1, 3, -3, 0])
	call check ([1, -3, 3, 0])
	call check ([6, 3, 5, 0])

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	deallocate (state_flv)

	call state%final ()
	deallocate (state)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: state_matrix_5"

	contains

	subroutine check (pdg)
	integer, dimension(4), intent(in) :: pdg
	integer, dimension(4) :: map
	logical :: success
	call state_flv%match (pdg, success, map)
	write (u, "(2x,4(1x,I0),':',1x,L1)", advance="no") pdg, success
	if (success) then
	write (u, "(2x,'map = (',4(1x,I0),' )')") map
	else
	write (u, *)
	end if
	end subroutine check

	end subroutine state_matrix_5

	@ %def state_matrix_5
	@
	Create a state matrix with full flavor, color and helicity information.
	Afterwards, reduce such that it is only differential in flavor and
	initial-state helicities. This is used when preparing states for beam-
	polarized computations with external matrix element providers.
	<<State matrices: execute tests>>=
	call test (state_matrix_6, "state_matrix_6", &
	"check state matrix reduction", &
	u, results)
	<<State matrices: test declarations>>=
	public :: state_matrix_6
	<<State matrices: tests>>=
	subroutine state_matrix_6 (u)
	integer, intent(in) :: u
	type(state_matrix_t), allocatable :: state_orig, state_reduced
	type(flavor_t), dimension(4) :: flv
	type(helicity_t), dimension(4) :: hel
	type(color_t), dimension(4) :: col
	type(quantum_numbers_t), dimension(4) :: qn
	type(quantum_numbers_mask_t), dimension(4) :: qn_mask
	integer :: h1, h2, h3 , h4
	integer :: n_states = 0

	write (u, "(A)") "* Test output: state_matrix_6"
	write (u, "(A)") "* Purpose: Check state matrix reduction"
	write (u, "(A)")

	write (u, "(A)") "* Set up helicity-diagonal state matrix"
	write (u, "(A)")

	allocate (state_orig)
	call state_orig%init ()

	call flv%init ([11, -11, 1, -1])
	call col(3)%init ([1])
	call col(4)%init ([-1])
	do h1 = -1, 1, 2
	do h2 = -1, 1, 2
	do h3 = -1, 1, 2
	do h4 = -1, 1, 2
	n_states = n_states + 1
	call hel%init ([h1, h2, h3, h4], [h1, h2, h3, h4])
	call qn%init (flv, col, hel)
	call state_orig%add_state (qn)
	end do
	end do
	end do
	end do
	call state_orig%freeze ()

	write (u, "(A)") "* Original state: "
	write (u, "(A)")
	call state_orig%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Setup quantum mask: "

	call qn_mask%init ([.false., .false., .false., .false.], &
	[.true., .true., .true., .true.], &
	[.false., .false., .true., .true.])
	call quantum_numbers_mask_write (qn_mask, u)
	write (u, "(A)")
	write (u, "(A)") "* Reducing the state matrix using above mask"
	write (u, "(A)")
	allocate (state_reduced)
	call state_orig%reduce (qn_mask, state_reduced)

	write (u, "(A)") "* Reduced state matrix: "
	call state_reduced%write (u)

	write (u, "(A)") "* Test output end: state_matrix_6"
	end subroutine state_matrix_6

	@ %def state_matrix_6
	@
	Create a state matrix with full flavor, color and helicity information.
	Afterwards, reduce such that it is only differential in flavor and
	initial-state helicities, and keeping old indices. Afterwards reorder the
	reduced state matrix in accordance to the original state matrix.
	<<State matrices: execute tests>>=
	call test (state_matrix_7, "state_matrix_7", &
	"check ordered state matrix reduction", &
	u, results)
	<<State matrices: test declarations>>=
	public :: state_matrix_7
	<<State matrices: tests>>=
	subroutine state_matrix_7 (u)
	integer, intent(in) :: u
	type(state_matrix_t), allocatable :: state_orig, state_reduced, &
	state_ordered
	type(flavor_t), dimension(4) :: flv
	type(helicity_t), dimension(4) :: hel
	type(color_t), dimension(4) :: col
	type(quantum_numbers_t), dimension(4) :: qn
	type(quantum_numbers_mask_t), dimension(4) :: qn_mask
	integer :: h1, h2, h3 , h4
	integer :: n_states = 0

	write (u, "(A)") "* Test output: state_matrix_7"
	write (u, "(A)") "* Purpose: Check ordered state matrix reduction"
	write (u, "(A)")

	write (u, "(A)") "* Set up helicity-diagonal state matrix"
	write (u, "(A)")

	allocate (state_orig)
	call state_orig%init ()

	call flv%init ([11, -11, 1, -1])
	call col(3)%init ([1])
	call col(4)%init ([-1])
	do h1 = -1, 1, 2
	do h2 = -1, 1, 2
	do h3 = -1, 1, 2
	do h4 = -1, 1, 2
	n_states = n_states + 1
	call hel%init ([h1, h2, h3, h4], [h1, h2, h3, h4])
	call qn%init (flv, col, hel)
	call state_orig%add_state (qn)
	end do
	end do
	end do
	end do
	call state_orig%freeze ()

	write (u, "(A)") "* Original state: "
	write (u, "(A)")
	call state_orig%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Setup quantum mask: "

	call qn_mask%init ([.false., .false., .false., .false.], &
	[.true., .true., .true., .true.], &
	[.false., .false., .true., .true.])
	call quantum_numbers_mask_write (qn_mask, u)
	write (u, "(A)")
	write (u, "(A)") "* Reducing the state matrix using above mask and keeping the old indices:"
	write (u, "(A)")
	allocate (state_reduced)
	call state_orig%reduce (qn_mask, state_reduced, keep_me_index = .true.)

	write (u, "(A)") "* Reduced state matrix with kept indices: "
	call state_reduced%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reordering reduced state matrix:"
	write (u, "(A)")
	allocate (state_ordered)
	call state_reduced%reorder_me (state_ordered)

	write (u, "(A)") "* Reduced and ordered state matrix:"
	call state_ordered%write (u)

	write (u, "(A)") "* Test output end: state_matrix_6"
	end subroutine state_matrix_7

	@ %def state_matrix_7
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Interactions}
	This module defines the [[interaction_t]] type. It is an extension of
	the [[state_matrix_t]] type.

	The state matrix is a representation of a multi-particle density
	matrix. It implements all possible flavor, color, and quantum-number
	assignments of the entries in a generic density matrix, and it can
	hold a complex matrix element for each entry. (Note that this matrix
	can hold non-diagonal entries in color and helicity space.) The
	[[interaction_t]] object associates this with a list of momenta, such
	that the whole object represents a multi-particle state.

	The [[interaction_t]] holds information about which particles are
	incoming, virtual (i.e., kept for the records), or outgoing. Each
	particle can be associated to a source within another interaction.
	This allows us to automatically fill those interaction momenta which
	have been computed or defined elsewhere. It also contains internal
	parent-child relations and flags for (virtual) particles which are to
	be treated as resonances.

	A quantum-number mask array summarizes, for each particle within the
	interaction, the treatment of flavor, color, or helicity (expose or
	ignore). A list of locks states which particles are bound to have an
	identical quantum-number mask. This is useful when the mask is
	changed at one place.
	<<[[interactions.f90]]>>=
	<<File header>>

	module interactions

	<<Use kinds>>
	use lorentz
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices

	<<Standard module head>>

	<<Interactions: public>>

	<<Interactions: types>>

	<<Interactions: interfaces>>

	interface
	<<Interactions: sub interfaces>>
	end interface

	end module interactions
	@ %def interactions
	<<[[interactions_sub.f90]]>>=
	<<File header>>

	submodule (interactions) interactions_s

	use io_units
	use diagnostics
	use sorting

	implicit none

	contains

	<<Interactions: procedures>>

	end submodule interactions_s

	@ %def interactions_s
	@ Given an ordered list of quantum numbers (without any subtraction index) map
	this list to a state matrix, such that each list index corresponds to an
	index of a set of quantum numbers in the state matrix, hence, the matrix element.

	The (unphysical) subtraction index is not a genuine quantum number and as
	such handled specially.
	<<Interactions: public>>=
	public :: qn_index_map_t
	<<Interactions: types>>=
	type :: qn_index_map_t
	private
	type(quantum_numbers_t), dimension(:, :), allocatable :: qn_flv
	type(quantum_numbers_t), dimension(:, :), allocatable :: qn_hel
	logical :: flip_hel = .false.
	integer :: n_flv = 0, n_hel = 0, n_sub = 0
	integer, dimension(:, :, :), allocatable :: index
	integer, dimension(:,:), allocatable :: sf_index_born, sf_index_real
	contains
	<<Interactions: qn index map: TBP>>
	end type qn_index_map_t

	@ %def qn_index_map_t
	@ Construct a mapping from interaction to an array of (sorted) quantum numbers.

	We strip all non-elementary particles (like beam) from the quantum numbers which
	we retrieve from the interaction.

	We consider helicity matrix elements only, when [[qn_hel]] is allocated.
	Else the helicity index is handled trivially as [[1]].

	For the rescaling of the structure functions in the real subtraction
	and DGLAP components we need a mapping (initialized by [[qn_index_map_init_sf]])
	from the real and born flavor structure indices to the structure function chain
	interaction matrix element with the correct initial state quantum numbers. This is stored
	in [[sf_index_born]] and [[sf_index_real]]. The array [[index]] is only needed for the
	initialisation of the Born and real index arrays and is therefore deallocated again.
	<<Interactions: qn index map: TBP>>=
	generic :: init => init_trivial, &
	init_involved, &
	init_sf
	procedure, private :: init_trivial => qn_index_map_init_trivial
	procedure, private :: init_involved => qn_index_map_init_involved
	procedure, private :: init_sf => qn_index_map_init_sf
	<<Interactions: sub interfaces>>=
	module subroutine qn_index_map_init_trivial (self, int)
	class(qn_index_map_t), intent(out) :: self
	class(interaction_t), intent(in) :: int
	end subroutine qn_index_map_init_trivial
	module subroutine qn_index_map_init_involved (self, int, qn_flv, n_sub, qn_hel)
	class(qn_index_map_t), intent(out) :: self
	type(interaction_t), intent(in) :: int
	type(quantum_numbers_t), dimension(:, :), intent(in) :: qn_flv
	integer, intent(in) :: n_sub
	type(quantum_numbers_t), dimension(:, :), intent(in), optional :: qn_hel
	end subroutine qn_index_map_init_involved
	module subroutine qn_index_map_init_sf (self, int, qn_flv, n_flv_born, n_flv_real)
	class(qn_index_map_t), intent(out) :: self
	type(interaction_t), intent(in) :: int
	integer, intent(in) :: n_flv_born, n_flv_real
	type(quantum_numbers_t), dimension(:,:), intent(in) :: qn_flv
	end subroutine qn_index_map_init_sf
	<<Interactions: procedures>>=
	module subroutine qn_index_map_init_trivial (self, int)
	class(qn_index_map_t), intent(out) :: self
	class(interaction_t), intent(in) :: int
	integer :: qn
	self%n_flv = int%get_n_matrix_elements ()
	self%n_hel = 1
	self%n_sub = 0
	allocate (self%index(self%n_flv, self%n_hel, 0:self%n_sub), source = 0)
	do qn = 1, self%n_flv
	self%index(qn, 1, 0) = qn
	end do
	end subroutine qn_index_map_init_trivial

	module subroutine qn_index_map_init_involved (self, int, qn_flv, n_sub, qn_hel)
	class(qn_index_map_t), intent(out) :: self
	type(interaction_t), intent(in) :: int
	type(quantum_numbers_t), dimension(:, :), intent(in) :: qn_flv
	integer, intent(in) :: n_sub
	type(quantum_numbers_t), dimension(:, :), intent(in), optional :: qn_hel
	type(quantum_numbers_t), dimension(:), allocatable :: qn, qn_int
	integer :: i, i_flv, i_hel, i_sub
	self%qn_flv = qn_flv
	self%n_flv = size (qn_flv, dim=2)
	self%n_sub = n_sub
	if (present (qn_hel)) then
	if (size (qn_flv, dim=1) /= size (qn_hel, dim=1)) then
	call msg_bug ("[qn_index_map_init] number of particles does not match.")
	end if
	self%qn_hel = qn_hel
	self%n_hel = size (qn_hel, dim=2)
	else
	self%n_hel = 1
	end if
	allocate (self%index (self%n_flv, self%n_hel, 0:self%n_sub), source=0)
	associate (n_me => int%get_n_matrix_elements ())
	do i = 1, n_me
	qn_int = int%get_quantum_numbers (i, by_me_index = .true.)
	qn = pack (qn_int, qn_int%are_hard_process ())
	i_flv = find_flv_index (self, qn)
	i_hel = 1; if (allocated (self%qn_hel)) &
	i_hel = find_hel_index (self, qn)
	i_sub = find_sub_index (self, qn)
	self%index(i_flv, i_hel, i_sub) = i
	end do
	end associate
	contains
	integer function find_flv_index (self, qn) result (i_flv)
	type(qn_index_map_t), intent(in) :: self
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer :: j
	i_flv = 0
	do j = 1, self%n_flv
	if (.not. all (qn .fmatch. self%qn_flv(:, j))) cycle
	i_flv = j
	exit
	end do
	if (i_flv < 1) then
	call msg_message ("QN:")
	call quantum_numbers_write (qn)
	call msg_message ("")
	call msg_message ("QN_FLV:")
	do j = 1, self%n_flv
	call quantum_numbers_write (self%qn_flv(:, j))
	call msg_message ("")
	end do
	call msg_bug ("[find_flv_index] could not find flv in qn_flv.")
	end if
	end function find_flv_index

	integer function find_hel_index (self, qn) result (i_hel)
	type(qn_index_map_t), intent(in) :: self
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer :: j
	i_hel = 0
	do j = 1, self%n_hel
	if (.not. all (qn .hmatch. self%qn_hel(:, j))) cycle
	i_hel = j
	exit
	end do
	if (i_hel < 1) then
	call msg_message ("QN:")
	call quantum_numbers_write (qn)
	call msg_message ("")
	call msg_message ("QN_HEL:")
	do j = 1, self%n_hel
	call quantum_numbers_write (self%qn_hel(:, j))
	call msg_message ("")
	end do
	call msg_bug ("[find_hel_index] could not find hel in qn_hel.")
	end if
	end function find_hel_index

	integer function find_sub_index (self, qn) result (i_sub)
	type(qn_index_map_t), intent(in) :: self
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer :: s
	i_sub = -1
	do s = 0, self%n_sub
	if ((all (pack(qn%get_sub (), qn%get_sub () > 0) == s)) &
	.or. (all (qn%get_sub () == 0) .and. s == 0)) then
	i_sub = s
	exit
	end if
	end do
	if (i_sub < 0) then
	call msg_message ("QN:")
	call quantum_numbers_write (qn)
	call msg_bug ("[find_sub_index] could not find sub in qn.")
	end if
	end function find_sub_index
	end subroutine qn_index_map_init_involved

	module subroutine qn_index_map_init_sf (self, int, qn_flv, n_flv_born, n_flv_real)
	class(qn_index_map_t), intent(out) :: self
	type(interaction_t), intent(in) :: int
	integer, intent(in) :: n_flv_born, n_flv_real
	type(quantum_numbers_t), dimension(:,:), intent(in) :: qn_flv
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn_int
	type(quantum_numbers_t), dimension(:), allocatable :: qn_int_tmp
	integer :: i, i_sub, n_flv, n_hard
	n_flv = int%get_n_matrix_elements ()
	qn_int_tmp = int%get_quantum_numbers (1, by_me_index = .true.)
	n_hard = count (qn_int_tmp%are_hard_process ())
	allocate (qn_int(n_hard, n_flv))
	do i = 1, n_flv
	qn_int_tmp = int%get_quantum_numbers (i, by_me_index = .true.)
	qn_int(:, i) = pack (qn_int_tmp, qn_int_tmp%are_hard_process ())
	end do
	call self%init (int, qn_int, int%get_n_sub ())
	allocate (self%sf_index_born(n_flv_born, 0:self%n_sub))
	allocate (self%sf_index_real(n_flv_real, 0:self%n_sub))
	do i_sub = 0, self%n_sub
	do i = 1, n_flv_born
	self%sf_index_born(i, i_sub) = self%get_index_by_qn (qn_flv(:,i), i_sub)
	end do
	do i = 1, n_flv_real
	self%sf_index_real(i, i_sub) = &
	self%get_index_by_qn (qn_flv(:,n_flv_born + i), i_sub)
	end do
	end do
	deallocate (self%index)
	end subroutine qn_index_map_init_sf

	@ %def qn_index_map_init_trivial
	@ %def qn_index_map_init_involved
	@ %def qn_index_map_init_sf
	@ Write the index map to unit.
	<<Interactions: qn index map: TBP>>=
	procedure :: write => qn_index_map_write
	<<Interactions: sub interfaces>>=
	module subroutine qn_index_map_write (self, unit)
	class(qn_index_map_t), intent(in) :: self
	integer, intent(in), optional :: unit
	end subroutine qn_index_map_write
	<<Interactions: procedures>>=
	module subroutine qn_index_map_write (self, unit)
	class(qn_index_map_t), intent(in) :: self
	integer, intent(in), optional :: unit
	integer :: u, i_flv, i_hel, i_sub
	u = given_output_unit (unit); if (u < 0) return
	write (u, *) "flip_hel: ", self%flip_hel
	do i_flv = 1, self%n_flv
	if (allocated (self%qn_flv)) &
	call quantum_numbers_write (self%qn_flv(:, i_flv))
	write (u, *)
	do i_hel = 1, self%n_hel
	if (allocated (self%qn_hel)) then
	call quantum_numbers_write (self%qn_hel(:, i_hel))
	write (u, *)
	end if
	do i_sub = 0, self%n_sub
	write (u, *) &
	"(", i_flv, ",", i_hel, ",", i_sub, ") => ", self%index(i_flv, i_hel, i_sub)
	end do
	end do
	end do
	end subroutine qn_index_map_write

	@ %def qn_index_map_write
	@ Set helicity convention. If [[flip]], then we flip the helicities of
	anti-particles and we remap the indices accordingly.
	<<Interactions: qn index map: TBP>>=
	procedure :: set_helicity_flip => qn_index_map_set_helicity_flip
	<<Interactions: sub interfaces>>=
	module subroutine qn_index_map_set_helicity_flip (self, yorn)
	class(qn_index_map_t), intent(inout) :: self
	logical, intent(in) :: yorn
	end subroutine qn_index_map_set_helicity_flip
	<<Interactions: procedures>>=
	module subroutine qn_index_map_set_helicity_flip (self, yorn)
	class(qn_index_map_t), intent(inout) :: self
	logical, intent(in) :: yorn
	integer :: i, i_flv, i_hel, i_hel_new
	type(quantum_numbers_t), dimension(:, :), allocatable :: qn_hel_flip
	integer, dimension(:, :, :), allocatable :: index
	if (.not. allocated (self%qn_hel)) then
	call msg_bug ("[qn_index_map_set_helicity_flip] &
	&cannot flip not-given helicity.")
	end if
	allocate (index (self%n_flv, self%n_hel, 0:self%n_sub), &
	source=self%index)
	self%flip_hel = yorn
	if (self%flip_hel) then
	do i_flv = 1, self%n_flv
	qn_hel_flip = self%qn_hel
	do i_hel = 1, self%n_hel
	do i = 1, size (self%qn_flv, dim=1)
	if (is_anti_particle (self%qn_flv(i, i_flv))) then
	call qn_hel_flip(i, i_hel)%flip_helicity ()
	end if
	end do
	end do
	do i_hel = 1, self%n_hel
	i_hel_new = find_hel_index (qn_hel_flip, self%qn_hel(:, i_hel))
	self%index(i_flv, i_hel_new, :) = index(i_flv, i_hel, :)
	end do
	end do
	end if
	contains
	logical function is_anti_particle (qn) result (yorn)
	type(quantum_numbers_t), intent(in) :: qn
	type(flavor_t) :: flv
	flv = qn%get_flavor ()
	yorn = flv%get_pdg () < 0
	end function is_anti_particle

	integer function find_hel_index (qn_sort, qn) result (i_hel)
	type(quantum_numbers_t), dimension(:, :), intent(in) :: qn_sort
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer :: j
	do j = 1, size(qn_sort, dim=2)
	if (.not. all (qn .hmatch. qn_sort(:, j))) cycle
	i_hel = j
	exit
	end do
	end function find_hel_index
	end subroutine qn_index_map_set_helicity_flip

	@ %def qn_index_map_set_helicity_flip
	@ Map from the previously given quantum number and subtraction
	index (latter ranging from 0 to [[n_sub]]) to the (interaction) matrix element.
	<<Interactions: qn index map: TBP>>=
	procedure :: get_index => qn_index_map_get_index
	<<Interactions: sub interfaces>>=
	module function qn_index_map_get_index (self, i_flv, i_hel, i_sub) result (index)
	class(qn_index_map_t), intent(in) :: self
	integer :: index
	integer, intent(in) :: i_flv
	integer, intent(in), optional :: i_hel
	integer, intent(in), optional :: i_sub
	end function qn_index_map_get_index
	<<Interactions: procedures>>=
	module function qn_index_map_get_index (self, i_flv, i_hel, i_sub) result (index)
	class(qn_index_map_t), intent(in) :: self
	integer :: index
	integer, intent(in) :: i_flv
	integer, intent(in), optional :: i_hel
	integer, intent(in), optional :: i_sub
	integer :: i_sub_opt, i_hel_opt
	i_sub_opt = 0; if (present (i_sub)) &
	i_sub_opt = i_sub
	i_hel_opt = 1; if (present (i_hel)) &
	i_hel_opt = i_hel
	index = 0
	if (.not. allocated (self%index)) then
	call msg_bug ("[qn_index_map_get_index] The index map is not allocated.")
	end if
	index = self%index(i_flv, i_hel_opt, i_sub_opt)
	if (index <= 0) then
	call self%write ()
	call msg_bug ("[qn_index_map_get_index] The index for the given quantum numbers could not be retrieved.")
	end if
	end function qn_index_map_get_index

	@ %def qn_index_map_get_i_flv
	@ Get [[n_flv]].
	<<Interactions: qn index map: TBP>>=
	procedure :: get_n_flv => qn_index_map_get_n_flv
	<<Interactions: sub interfaces>>=
	module function qn_index_map_get_n_flv (self) result (n_flv)
	class(qn_index_map_t), intent(in) :: self
	integer :: n_flv
	end function qn_index_map_get_n_flv
	<<Interactions: procedures>>=
	module function qn_index_map_get_n_flv (self) result (n_flv)
	class(qn_index_map_t), intent(in) :: self
	integer :: n_flv
	n_flv = self%n_flv
	end function qn_index_map_get_n_flv

	@ %def qn_index_map_get_n_flv
	@ Get [[n_hel]].
	<<Interactions: qn index map: TBP>>=
	procedure :: get_n_hel => qn_index_map_get_n_hel
	<<Interactions: sub interfaces>>=
	module function qn_index_map_get_n_hel (self) result (n_hel)
	class(qn_index_map_t), intent(in) :: self
	integer :: n_hel
	end function qn_index_map_get_n_hel
	<<Interactions: procedures>>=
	module function qn_index_map_get_n_hel (self) result (n_hel)
	class(qn_index_map_t), intent(in) :: self
	integer :: n_hel
	n_hel = self%n_hel
	end function qn_index_map_get_n_hel

	@ %def qn_index_map_get_n_flv
	@ Get [[n_sub]].
	<<Interactions: qn index map: TBP>>=
	procedure :: get_n_sub => qn_index_map_get_n_sub
	<<Interactions: sub interfaces>>=
	module function qn_index_map_get_n_sub (self) result (n_sub)
	class(qn_index_map_t), intent(in) :: self
	integer :: n_sub
	end function qn_index_map_get_n_sub
	<<Interactions: procedures>>=
	module function qn_index_map_get_n_sub (self) result (n_sub)
	class(qn_index_map_t), intent(in) :: self
	integer :: n_sub
	n_sub = self%n_sub
	end function qn_index_map_get_n_sub

	@ %def qn_index_map_get_n_sub
	@ Gets the index for the matrix element corresponding to a set of quantum numbers.
	So far, it ignores helicity (and color) indices.
	<<Interactions: qn index map: TBP>>=
	procedure :: get_index_by_qn => qn_index_map_get_index_by_qn
	<<Interactions: sub interfaces>>=
	module function qn_index_map_get_index_by_qn (self, qn, i_sub) result (index)
	class(qn_index_map_t), intent(in) :: self
	integer :: index
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer, intent(in), optional :: i_sub
	end function qn_index_map_get_index_by_qn
	<<Interactions: procedures>>=
	module function qn_index_map_get_index_by_qn (self, qn, i_sub) result (index)
	class(qn_index_map_t), intent(in) :: self
	integer :: index
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer, intent(in), optional :: i_sub
	integer :: i_qn
	if (size (qn) /= size (self%qn_flv, dim = 1)) &
	call msg_bug ("[qn_index_map_get_index_by_qn] number of particles does not match.")
	do i_qn = 1, self%n_flv
	if (all (qn .fmatch. self%qn_flv(:, i_qn))) then
	index = self%get_index (i_qn, i_sub = i_sub)
	return
	end if
	end do
	call self%write ()
	call msg_bug ("[qn_index_map_get_index_by_qn] The index for the given quantum &
	& numbers could not be retrieved.")
	end function qn_index_map_get_index_by_qn

	@ %def qn_index_map_get_index_by_qn
	@
	<<Interactions: qn index map: TBP>>=
	procedure :: get_sf_index_born => qn_index_map_get_sf_index_born
	<<Interactions: sub interfaces>>=
	module function qn_index_map_get_sf_index_born (self, i_born, i_sub) result (index)
	class(qn_index_map_t), intent(in) :: self
	integer, intent(in) :: i_born, i_sub
	integer :: index
	end function qn_index_map_get_sf_index_born
	<<Interactions: procedures>>=
	module function qn_index_map_get_sf_index_born (self, i_born, i_sub) result (index)
	class(qn_index_map_t), intent(in) :: self
	integer, intent(in) :: i_born, i_sub
	integer :: index
	index = self%sf_index_born(i_born, i_sub)
	end function qn_index_map_get_sf_index_born

	@ %def qn_index_map_get_sf_index_born
	@
	<<Interactions: qn index map: TBP>>=
	procedure :: get_sf_index_real => qn_index_map_get_sf_index_real
	<<Interactions: sub interfaces>>=
	module function qn_index_map_get_sf_index_real (self, i_real, i_sub) result (index)
	class(qn_index_map_t), intent(in) :: self
	integer, intent(in) :: i_real, i_sub
	integer :: index
	end function qn_index_map_get_sf_index_real
	<<Interactions: procedures>>=
	module function qn_index_map_get_sf_index_real (self, i_real, i_sub) result (index)
	class(qn_index_map_t), intent(in) :: self
	integer, intent(in) :: i_real, i_sub
	integer :: index
	index = self%sf_index_real(i_real, i_sub)
	end function qn_index_map_get_sf_index_real

	@ %def qn_index_map_get_sf_index_real
	@
	\subsection{External interaction links}
	Each particle in an interaction can have a link to a corresponding
	particle in another interaction. This allows to fetch the momenta of
	incoming or virtual particles from the interaction where they are
	defined. The link object consists of a pointer to the interaction and
	an index.
	<<Interactions: types>>=
	type :: external_link_t
	private
	type(interaction_t), pointer :: int => null ()
	integer :: i
	end type external_link_t

	@ %def external_link_t
	@ Set an external link.
	<<Interactions: sub interfaces>>=
	module subroutine external_link_set (link, int, i)
	type(external_link_t), intent(out) :: link
	type(interaction_t), target, intent(in) :: int
	integer, intent(in) :: i
	end subroutine external_link_set
	<<Interactions: procedures>>=
	module subroutine external_link_set (link, int, i)
	type(external_link_t), intent(out) :: link
	type(interaction_t), target, intent(in) :: int
	integer, intent(in) :: i
	if (i /= 0) then
	link%int => int
	link%i = i
	end if
	end subroutine external_link_set

	@ %def external_link_set
	@ Reassign an external link to a new interaction (which should be an
	image of the original target).
	<<Interactions: sub interfaces>>=
	module subroutine external_link_reassign (link, int_src, int_target)
	type(external_link_t), intent(inout) :: link
	type(interaction_t), intent(in) :: int_src
	type(interaction_t), intent(in), target :: int_target
	end subroutine external_link_reassign
	<<Interactions: procedures>>=
	module subroutine external_link_reassign (link, int_src, int_target)
	type(external_link_t), intent(inout) :: link
	type(interaction_t), intent(in) :: int_src
	type(interaction_t), intent(in), target :: int_target
	if (associated (link%int)) then
	if (link%int%tag == int_src%tag) link%int => int_target
	end if
	end subroutine external_link_reassign

	@ %def external_link_reassign
	@ Return true if the link is set
	<<Interactions: sub interfaces>>=
	module function external_link_is_set (link) result (flag)
	logical :: flag
	type(external_link_t), intent(in) :: link
	end function external_link_is_set
	<<Interactions: procedures>>=
	module function external_link_is_set (link) result (flag)
	logical :: flag
	type(external_link_t), intent(in) :: link
	flag = associated (link%int)
	end function external_link_is_set

	@ %def external_link_is_set
	@ Return the interaction pointer.
	<<Interactions: public>>=
	public :: external_link_get_ptr
	<<Interactions: sub interfaces>>=
	module function external_link_get_ptr (link) result (int)
	type(interaction_t), pointer :: int
	type(external_link_t), intent(in) :: link
	end function external_link_get_ptr
	<<Interactions: procedures>>=
	module function external_link_get_ptr (link) result (int)
	type(interaction_t), pointer :: int
	type(external_link_t), intent(in) :: link
	int => link%int
	end function external_link_get_ptr

	@ %def external_link_get_ptr
	@ Return the index within that interaction
	<<Interactions: public>>=
	public :: external_link_get_index
	<<Interactions: sub interfaces>>=
	module function external_link_get_index (link) result (i)
	integer :: i
	type(external_link_t), intent(in) :: link
	end function external_link_get_index
	<<Interactions: procedures>>=
	module function external_link_get_index (link) result (i)
	integer :: i
	type(external_link_t), intent(in) :: link
	i = link%i
	end function external_link_get_index

	@ %def external_link_get_index
	@ Return a pointer to the momentum of the corresponding particle. If
	there is no association, return a null pointer.
	<<Interactions: sub interfaces>>=
	module function external_link_get_momentum_ptr (link) result (p)
	type(vector4_t), pointer :: p
	type(external_link_t), intent(in) :: link
	end function external_link_get_momentum_ptr
	<<Interactions: procedures>>=
	module function external_link_get_momentum_ptr (link) result (p)
	type(vector4_t), pointer :: p
	type(external_link_t), intent(in) :: link
	if (associated (link%int)) then
	p => link%int%p(link%i)
	else
	p => null ()
	end if
	end function external_link_get_momentum_ptr

	@ %def external_link_get_momentum_ptr
	@
	\subsection{Internal relations}
	In addition to the external links, particles within the interaction
	have parent-child relations. Here, more than one link is possible,
	and we set up an array.
	<<Interactions: types>>=
	type :: internal_link_list_t
	private
	integer :: length = 0
	integer, dimension(:), allocatable :: link
	contains
	<<Interactions: internal link list: TBP>>
	end type internal_link_list_t

	@ %def internal_link_t internal_link_list_t
	@ Output, non-advancing.
	<<Interactions: internal link list: TBP>>=
	procedure :: write => internal_link_list_write
	<<Interactions: sub interfaces>>=
	module subroutine internal_link_list_write (object, unit)
	class(internal_link_list_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine internal_link_list_write
	<<Interactions: procedures>>=
	module subroutine internal_link_list_write (object, unit)
	class(internal_link_list_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	do i = 1, object%length
	write (u, "(1x,I0)", advance="no") object%link(i)
	end do
	end subroutine internal_link_list_write

	@ %def internal_link_list_write
	@ Append an item. Start with an array size of 2 and double the size
	if necessary.

	Make sure that the indices are stored in ascending order. To this
	end, shift the existing entries right, starting from the end, as long
	as they are larger than the new entry.
	<<Interactions: internal link list: TBP>>=
	procedure :: append => internal_link_list_append
	<<Interactions: sub interfaces>>=
	module subroutine internal_link_list_append (link_list, link)
	class(internal_link_list_t), intent(inout) :: link_list
	integer, intent(in) :: link
	end subroutine internal_link_list_append
	<<Interactions: procedures>>=
	module subroutine internal_link_list_append (link_list, link)
	class(internal_link_list_t), intent(inout) :: link_list
	integer, intent(in) :: link
	integer :: l, j
	integer, dimension(:), allocatable :: tmp
	l = link_list%length
	if (allocated (link_list%link)) then
	if (l == size (link_list%link)) then
	allocate (tmp (2 * l))
	tmp(:l) = link_list%link
	call move_alloc (from = tmp, to = link_list%link)
	end if
	else
	allocate (link_list%link (2))
	end if
	link_list%link(l+1) = link
	SHIFT_LINK_IN_PLACE: do j = l, 1, -1
	if (link >= link_list%link(j)) then
	exit SHIFT_LINK_IN_PLACE
	else
	link_list%link(j+1) = link_list%link(j)
	link_list%link(j) = link
	end if
	end do SHIFT_LINK_IN_PLACE
	link_list%length = l + 1
	end subroutine internal_link_list_append

	@ %def internal_link_list_append
	@ Return true if the link list is nonempty:
	<<Interactions: internal link list: TBP>>=
	procedure :: has_entries => internal_link_list_has_entries
	<<Interactions: sub interfaces>>=
	module function internal_link_list_has_entries (link_list) result (flag)
	class(internal_link_list_t), intent(in) :: link_list
	logical :: flag
	end function internal_link_list_has_entries
	<<Interactions: procedures>>=
	module function internal_link_list_has_entries (link_list) result (flag)
	class(internal_link_list_t), intent(in) :: link_list
	logical :: flag
	flag = link_list%length > 0
	end function internal_link_list_has_entries

	@ %def internal_link_list_has_entries
	@ Return the list length
	<<Interactions: internal link list: TBP>>=
	procedure :: get_length => internal_link_list_get_length
	<<Interactions: sub interfaces>>=
	module function internal_link_list_get_length (link_list) result (length)
	class(internal_link_list_t), intent(in) :: link_list
	integer :: length
	end function internal_link_list_get_length
	<<Interactions: procedures>>=
	module function internal_link_list_get_length (link_list) result (length)
	class(internal_link_list_t), intent(in) :: link_list
	integer :: length
	length = link_list%length
	end function internal_link_list_get_length

	@ %def internal_link_list_get_length
	@ Return an entry.
	<<Interactions: internal link list: TBP>>=
	procedure :: get_link => internal_link_list_get_link
	<<Interactions: sub interfaces>>=
	module function internal_link_list_get_link (link_list, i) result (link)
	class(internal_link_list_t), intent(in) :: link_list
	integer, intent(in) :: i
	integer :: link
	end function internal_link_list_get_link
	<<Interactions: procedures>>=
	module function internal_link_list_get_link (link_list, i) result (link)
	class(internal_link_list_t), intent(in) :: link_list
	integer, intent(in) :: i
	integer :: link
	if (i <= link_list%length) then
	link = link_list%link(i)
	else
	call msg_bug ("Internal link list: out of bounds")
	end if
	end function internal_link_list_get_link

	@ %def internal_link_list_get_link
	@
	\subsection{The interaction type}
	An interaction is an entangled system of particles. Thus, the
	interaction object consists of two parts: the subevent, and the
	quantum state which technically is a trie. The subnode levels beyond
	the trie root node are in correspondence to the subevent, so
	both should be traversed in parallel.

	The subevent is implemented as an allocatable array of
	four-momenta. The first [[n_in]] particles are incoming, [[n_vir]]
	particles in-between can be kept for bookkeeping, and the last
	[[n_out]] particles are outgoing.

	Distinct interactions are linked by their particles: for each
	particle, we have the possibility of links to corresponding particles
	in other interactions. Furthermore, for bookkeeping purposes we have
	a self-link array [[relations]] where the parent-child relations are
	kept, and a flag array [[resonant]] which is set for an intermediate
	resonance.

	Each momentum is associated with masks for flavor, color, and
	helicity. If a mask entry is set, the associated quantum number is to
	be ignored for that particle. If any mask has changed, the flag
	[[update]] is set.

	We can have particle pairs locked together. If this is the case, the
	corresponding mask entries are bound to be equal. This is useful for
	particles that go through the interaction.

	The interaction tag serves bookkeeping purposes. In particular, it
	identifies links in printout.
	<<Interactions: public>>=
	public :: interaction_t
	<<Interactions: types>>=
	type :: interaction_t
	private
	integer :: tag = 0
	type(state_matrix_t) :: state_matrix
	integer :: n_in = 0
	integer :: n_vir = 0
	integer :: n_out = 0
	integer :: n_tot = 0
	logical, dimension(:), allocatable :: p_is_known
	type(vector4_t), dimension(:), allocatable :: p
	type(external_link_t), dimension(:), allocatable :: source
	type(internal_link_list_t), dimension(:), allocatable :: parents
	type(internal_link_list_t), dimension(:), allocatable :: children
	logical, dimension(:), allocatable :: resonant
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
	integer, dimension(:), allocatable :: hel_lock
	logical :: update_state_matrix = .false.
	logical :: update_values = .false.
	type(qn_index_map_t) :: qn_index
	contains
	<<Interactions: interaction: TBP>>
	end type interaction_t

	@ %def interaction_particle_p interaction_t
	@ Initialize the particle array with a fixed size. The first [[n_in]]
	particles are incoming, the rest outgoing. Masks are optional. There
	is also an optional tag. The interaction still needs fixing the
	values, but that is to be done after all branches have been added.

	Interaction tags are assigned consecutively, using a [[save]]d
	variable local to this procedure. If desired, we can provide a seed
	for the interaction tags. Such a seed should be positive. The
	default seed is one. [[tag=0]] indicates an empty interaction.

	If [[set_relations]] is set and true, we establish parent-child
	relations for all incoming and outgoing particles. Virtual particles
	are skipped; this option is normally used only for interations without
	virtual particles.
	<<Interactions: interaction: TBP>>=
	procedure :: basic_init => interaction_init
	<<Interactions: sub interfaces>>=
	module subroutine interaction_init &
	(int, n_in, n_vir, n_out, &
	tag, resonant, mask, hel_lock, set_relations, store_values)
	class(interaction_t), intent(out) :: int
	integer, intent(in) :: n_in, n_vir, n_out
	integer, intent(in), optional :: tag
	logical, dimension(:), intent(in), optional :: resonant
	type(quantum_numbers_mask_t), dimension(:), intent(in), optional :: mask
	integer, dimension(:), intent(in), optional :: hel_lock
	logical, intent(in), optional :: set_relations, store_values
	end subroutine interaction_init
	<<Interactions: procedures>>=
	module subroutine interaction_init &
	(int, n_in, n_vir, n_out, &
	tag, resonant, mask, hel_lock, set_relations, store_values)
	class(interaction_t), intent(out) :: int
	integer, intent(in) :: n_in, n_vir, n_out
	integer, intent(in), optional :: tag
	logical, dimension(:), intent(in), optional :: resonant
	type(quantum_numbers_mask_t), dimension(:), intent(in), optional :: mask
	integer, dimension(:), intent(in), optional :: hel_lock
	logical, intent(in), optional :: set_relations, store_values
	logical :: set_rel
	integer :: i, j
	set_rel = .false.; if (present (set_relations)) set_rel = set_relations
	call interaction_set_tag (int, tag)
	call int%state_matrix%init (store_values)
	int%n_in = n_in
	int%n_vir = n_vir
	int%n_out = n_out
	int%n_tot = n_in + n_vir + n_out
	allocate (int%p_is_known (int%n_tot))
	int%p_is_known = .false.
	allocate (int%p (int%n_tot))
	allocate (int%source (int%n_tot))
	allocate (int%parents (int%n_tot))
	allocate (int%children (int%n_tot))
	allocate (int%resonant (int%n_tot))
	if (present (resonant)) then
	int%resonant = resonant
	else
	int%resonant = .false.
	end if
	allocate (int%mask (int%n_tot))
	allocate (int%hel_lock (int%n_tot))
	if (present (mask)) then
	int%mask = mask
	end if
	if (present (hel_lock)) then
	int%hel_lock = hel_lock
	else
	int%hel_lock = 0
	end if
	int%update_state_matrix = .false.
	int%update_values = .true.
	if (set_rel) then
	do i = 1, n_in
	do j = 1, n_out
	call int%relate (i, n_in + j)
	end do
	end do
	end if
	end subroutine interaction_init

	@ %def interaction_init
	@
	<<Interactions: interaction: TBP>>=
	generic :: init_qn_index => init_qn_index_trivial, &
	init_qn_index_involved, &
	init_qn_index_sf
	procedure :: init_qn_index_trivial => interaction_init_qn_index_trivial
	procedure :: init_qn_index_involved => interaction_init_qn_index_involved
	procedure :: init_qn_index_sf => interaction_init_qn_index_sf
	<<Interactions: sub interfaces>>=
	module subroutine interaction_init_qn_index_trivial (int)
	class(interaction_t), intent(inout) :: int
	end subroutine interaction_init_qn_index_trivial
	module subroutine interaction_init_qn_index_involved (int, qn_flv, n_sub, qn_hel)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_t), dimension(:, :), intent(in) :: qn_flv
	integer, intent(in) :: n_sub
	type(quantum_numbers_t), dimension(:, :), intent(in), optional :: qn_hel
	end subroutine interaction_init_qn_index_involved
	module subroutine interaction_init_qn_index_sf (int, qn_flv, n_flv_born, n_flv_real)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: n_flv_born, n_flv_real
	type(quantum_numbers_t), dimension(:,:), intent(in) :: qn_flv
	end subroutine interaction_init_qn_index_sf
	<<Interactions: procedures>>=
	module subroutine interaction_init_qn_index_trivial (int)
	class(interaction_t), intent(inout) :: int
	call int%qn_index%init (int)
	end subroutine interaction_init_qn_index_trivial

	module subroutine interaction_init_qn_index_involved (int, qn_flv, n_sub, qn_hel)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_t), dimension(:, :), intent(in) :: qn_flv
	integer, intent(in) :: n_sub
	type(quantum_numbers_t), dimension(:, :), intent(in), optional :: qn_hel
	call int%qn_index%init (int, qn_flv, n_sub, qn_hel)
	end subroutine interaction_init_qn_index_involved

	module subroutine interaction_init_qn_index_sf (int, qn_flv, n_flv_born, n_flv_real)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: n_flv_born, n_flv_real
	type(quantum_numbers_t), dimension(:,:), intent(in) :: qn_flv
	call int%qn_index%init (int, qn_flv, n_flv_born, n_flv_real)
	end subroutine interaction_init_qn_index_sf

	@ %def interaction_init_qn_index_trivial
	@ %def interaction_init_qn_index
	@ %def interaction_init_qn_index_sf
	@
	<<Interactions: interaction: TBP>>=
	procedure :: set_qn_index_helicity_flip => interaction_set_qn_index_helicity_flip
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_qn_index_helicity_flip (int, yorn)
	class(interaction_t), intent(inout) :: int
	logical, intent(in) :: yorn
	end subroutine interaction_set_qn_index_helicity_flip
	<<Interactions: procedures>>=
	module subroutine interaction_set_qn_index_helicity_flip (int, yorn)
	class(interaction_t), intent(inout) :: int
	logical, intent(in) :: yorn
	call int%qn_index%set_helicity_flip (yorn)
	end subroutine interaction_set_qn_index_helicity_flip

	@ %def interaction_get_qn_index_n_flv
	@
	<<Interactions: interaction: TBP>>=
	procedure :: get_qn_index => interaction_get_qn_index
	procedure :: get_sf_qn_index_born => interaction_get_sf_qn_index_born
	procedure :: get_sf_qn_index_real => interaction_get_sf_qn_index_real
	<<Interactions: sub interfaces>>=
	module function interaction_get_qn_index (int, i_flv, i_hel, i_sub) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	integer, intent(in) :: i_flv
	integer, intent(in), optional :: i_hel
	integer, intent(in), optional :: i_sub
	end function interaction_get_qn_index
	module function interaction_get_sf_qn_index_born (int, i_born, i_sub) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	integer, intent(in) :: i_born, i_sub
	end function interaction_get_sf_qn_index_born
	module function interaction_get_sf_qn_index_real (int, i_real, i_sub) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	integer, intent(in) :: i_real, i_sub
	end function interaction_get_sf_qn_index_real
	<<Interactions: procedures>>=
	module function interaction_get_qn_index (int, i_flv, i_hel, i_sub) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	integer, intent(in) :: i_flv
	integer, intent(in), optional :: i_hel
	integer, intent(in), optional :: i_sub
	index = int%qn_index%get_index (i_flv, i_hel, i_sub)
	end function interaction_get_qn_index

	module function interaction_get_sf_qn_index_born (int, i_born, i_sub) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	integer, intent(in) :: i_born, i_sub
	index = int%qn_index%get_sf_index_born (i_born, i_sub)
	end function interaction_get_sf_qn_index_born

	module function interaction_get_sf_qn_index_real (int, i_real, i_sub) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	integer, intent(in) :: i_real, i_sub
	index = int%qn_index%get_sf_index_real (i_real, i_sub)
	end function interaction_get_sf_qn_index_real

	@ %def interaction_get_qn_index
	@ %def interaction_get_sf_qn_index_born
	@ %def interaction_get_sf_qn_index_real
	@
	<<Interactions: interaction: TBP>>=
	procedure :: get_qn_index_n_flv => interaction_get_qn_index_n_flv
	procedure :: get_qn_index_n_hel => interaction_get_qn_index_n_hel
	procedure :: get_qn_index_n_sub => interaction_get_qn_index_n_sub
	<<Interactions: sub interfaces>>=
	module function interaction_get_qn_index_n_flv (int) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	end function interaction_get_qn_index_n_flv
	module function interaction_get_qn_index_n_hel (int) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	end function interaction_get_qn_index_n_hel
	module function interaction_get_qn_index_n_sub (int) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	end function interaction_get_qn_index_n_sub
	<<Interactions: procedures>>=
	module function interaction_get_qn_index_n_flv (int) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	index = int%qn_index%get_n_flv ()
	end function interaction_get_qn_index_n_flv

	module function interaction_get_qn_index_n_hel (int) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	index = int%qn_index%get_n_hel ()
	end function interaction_get_qn_index_n_hel

	module function interaction_get_qn_index_n_sub (int) result (index)
	class(interaction_t), intent(in) :: int
	integer :: index
	index = int%qn_index%get_n_sub ()
	end function interaction_get_qn_index_n_sub

	@ %def interaction_get_qn_index_n_flv
	@ %def interaction_get_qn_index_n_hel
	@ %def interaction_get_qn_index_n_sub
	@ Set or create a unique tag for the interaction. Without
	interaction, reset the tag counter.
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_tag (int, tag)
	type(interaction_t), intent(inout), optional :: int
	integer, intent(in), optional :: tag
	end subroutine interaction_set_tag
	<<Interactions: procedures>>=
	module subroutine interaction_set_tag (int, tag)
	type(interaction_t), intent(inout), optional :: int
	integer, intent(in), optional :: tag
	integer, save :: stored_tag = 1
	if (present (int)) then
	if (present (tag)) then
	int%tag = tag
	else
	int%tag = stored_tag
	stored_tag = stored_tag + 1
	end if
	else if (present (tag)) then
	stored_tag = tag
	else
	stored_tag = 1
	end if
	end subroutine interaction_set_tag

	@ %def interaction_set_tag
	@ The public interface for the previous procedure only covers the
	reset functionality.
	<<Interactions: public>>=
	public :: reset_interaction_counter
	<<Interactions: sub interfaces>>=
	module subroutine reset_interaction_counter (tag)
	integer, intent(in), optional :: tag
	end subroutine reset_interaction_counter
	<<Interactions: procedures>>=
	module subroutine reset_interaction_counter (tag)
	integer, intent(in), optional :: tag
	call interaction_set_tag (tag=tag)
	end subroutine reset_interaction_counter

	@ %def reset_interaction_counter
	@ Finalizer: The state-matrix object contains pointers.
	<<Interactions: interaction: TBP>>=
	procedure :: final => interaction_final
	<<Interactions: sub interfaces>>=
	module subroutine interaction_final (object)
	class(interaction_t), intent(inout) :: object
	end subroutine interaction_final
	<<Interactions: procedures>>=
	module subroutine interaction_final (object)
	class(interaction_t), intent(inout) :: object
	call object%state_matrix%final ()
	end subroutine interaction_final

	@ %def interaction_final
	@ Output. The [[verbose]] option refers to the state matrix output.
	<<Interactions: interaction: TBP>>=
	procedure :: basic_write => interaction_write
	<<Interactions: sub interfaces>>=
	module subroutine interaction_write &
	(int, unit, verbose, show_momentum_sum, show_mass, show_state, &
	col_verbose, testflag)
	class(interaction_t), intent(in) :: int
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, show_momentum_sum, show_mass
	logical, intent(in), optional :: show_state, col_verbose, testflag
	end subroutine interaction_write
	<<Interactions: procedures>>=
	module subroutine interaction_write &
	(int, unit, verbose, show_momentum_sum, show_mass, show_state, &
	col_verbose, testflag)
	class(interaction_t), intent(in) :: int
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, show_momentum_sum, show_mass
	logical, intent(in), optional :: show_state, col_verbose, testflag
	integer :: u
	integer :: i, index_link
	type(interaction_t), pointer :: int_link
	logical :: show_st
	u = given_output_unit (unit); if (u < 0) return
	show_st = .true.; if (present (show_state)) show_st = show_state
	if (int%tag /= 0) then
	write (u, "(1x,A,I0)") "Interaction: ", int%tag
	do i = 1, int%n_tot
	if (i == 1 .and. int%n_in > 0) then
	write (u, "(1x,A)") "Incoming:"
	else if (i == int%n_in + 1 .and. int%n_vir > 0) then
	write (u, "(1x,A)") "Virtual:"
	else if (i == int%n_in + int%n_vir + 1 .and. int%n_out > 0) then
	write (u, "(1x,A)") "Outgoing:"
	end if
	write (u, "(1x,A,1x,I0)", advance="no") "Particle", i
	if (allocated (int%resonant)) then
	if (int%resonant(i)) then
	write (u, "(A)") "[r]"
	else
	write (u, *)
	end if
	else
	write (u, *)
	end if
	if (allocated (int%p)) then
	if (int%p_is_known(i)) then
	call vector4_write (int%p(i), u, show_mass, testflag)
	else
	write (u, "(A)") " [momentum undefined]"
	end if
	else
	write (u, "(A)") " [momentum not allocated]"
	end if
	if (allocated (int%mask)) then
	write (u, "(1x,A)", advance="no") "mask [fch] = "
	call int%mask(i)%write (u)
	write (u, *)
	end if
	if (int%parents(i)%has_entries () &
	.or. int%children(i)%has_entries ()) then
	write (u, "(1x,A)", advance="no") "internal links:"
	call int%parents(i)%write (u)
	if (int%parents(i)%has_entries ()) &
	write (u, "(1x,A)", advance="no") "=>"
	write (u, "(1x,A)", advance="no") "X"
	if (int%children(i)%has_entries ()) &
	write (u, "(1x,A)", advance="no") "=>"
	call int%children(i)%write (u)
	write (u, *)
	end if
	if (allocated (int%hel_lock)) then
	if (int%hel_lock(i) /= 0) then
	write (u, "(1x,A,1x,I0)") "helicity lock:", int%hel_lock(i)
	end if
	end if
	if (external_link_is_set (int%source(i))) then
	write (u, "(1x,A)", advance="no") "source:"
	int_link => external_link_get_ptr (int%source(i))
	index_link = external_link_get_index (int%source(i))
	write (u, "(1x,'(',I0,')',I0)", advance="no") &
	int_link%tag, index_link
	write (u, *)
	end if
	end do
	if (present (show_momentum_sum)) then
	if (allocated (int%p) .and. show_momentum_sum) then
	write (u, "(1x,A)") "Incoming particles (sum):"
	call vector4_write &
	(sum (int%p(1 : int%n_in)), u, show_mass = show_mass)
	write (u, "(1x,A)") "Outgoing particles (sum):"
	call vector4_write &
	(sum (int%p(int%n_in + int%n_vir + 1 : )), &
	u, show_mass = show_mass)
	write (u, *)
	end if
	end if
	if (show_st) then
	call int%write_state_matrix (write_value_list = verbose, &
	verbose = verbose, unit = unit, col_verbose = col_verbose, &
	testflag = testflag)
	end if
	else
	write (u, "(1x,A)") "Interaction: [empty]"
	end if
	end subroutine interaction_write

	@ %def interaction_write
	@
	<<Interactions: interaction: TBP>>=
	procedure :: write_state_matrix => interaction_write_state_matrix
	<<Interactions: sub interfaces>>=
	module subroutine interaction_write_state_matrix (int, unit, write_value_list, &
	verbose, col_verbose, testflag)
	class(interaction_t), intent(in) :: int
	logical, intent(in), optional :: write_value_list, verbose, col_verbose
	logical, intent(in), optional :: testflag
	integer, intent(in), optional :: unit
	end subroutine interaction_write_state_matrix
	<<Interactions: procedures>>=
	module subroutine interaction_write_state_matrix (int, unit, write_value_list, &
	verbose, col_verbose, testflag)
	class(interaction_t), intent(in) :: int
	logical, intent(in), optional :: write_value_list, verbose, col_verbose
	logical, intent(in), optional :: testflag
	integer, intent(in), optional :: unit
	call int%state_matrix%write (write_value_list = verbose, &
	verbose = verbose, unit = unit, col_verbose = col_verbose, &
	testflag = testflag)
	end subroutine interaction_write_state_matrix

	@ %def interaction_write_state_matrix
	@ Reduce the [[state_matrix]] over the quantum mask. During the reduce procedure
	the iterator does not conserve the order of the matrix element respective their
	quantum numbers. Setting the [[keep_order]] results in a reorder state matrix
	with reintroduced matrix element indices.
	<<Interactions: interaction: TBP>>=
	procedure :: reduce_state_matrix => interaction_reduce_state_matrix
	<<Interactions: sub interfaces>>=
	module subroutine interaction_reduce_state_matrix (int, qn_mask, keep_order)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask
	logical, optional, intent(in) :: keep_order
	end subroutine interaction_reduce_state_matrix
	<<Interactions: procedures>>=
	module subroutine interaction_reduce_state_matrix (int, qn_mask, keep_order)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask
	logical, optional, intent(in) :: keep_order
	type(state_matrix_t) :: state
	logical :: opt_keep_order
	opt_keep_order = .false.
	if (present (keep_order)) opt_keep_order = keep_order
	call int%state_matrix%reduce (qn_mask, state, keep_me_index = keep_order)
	int%state_matrix = state
	if (opt_keep_order) then
	call int%state_matrix%reorder_me (state)
	int%state_matrix = state
	end if
	end subroutine interaction_reduce_state_matrix

	@ %def interaction_reduce_state_matrix
	@ Assignment: We implement this as a deep copy. This applies, in
	particular, to the state-matrix and internal-link components.
	Furthermore, the new interaction acquires a new tag.
	<<Interactions: public>>=
	public :: assignment(=)
	<<Interactions: interfaces>>=
	interface assignment(=)
	module procedure interaction_assign
	end interface

	<<Interactions: sub interfaces>>=
	module subroutine interaction_assign (int_out, int_in)
	type(interaction_t), intent(out) :: int_out
	type(interaction_t), intent(in), target :: int_in
	end subroutine interaction_assign
	<<Interactions: procedures>>=
	module subroutine interaction_assign (int_out, int_in)
	type(interaction_t), intent(out) :: int_out
	type(interaction_t), intent(in), target :: int_in
	call interaction_set_tag (int_out)
	int_out%state_matrix = int_in%state_matrix
	int_out%n_in = int_in%n_in
	int_out%n_out = int_in%n_out
	int_out%n_vir = int_in%n_vir
	int_out%n_tot = int_in%n_tot
	if (allocated (int_in%p_is_known)) then
	allocate (int_out%p_is_known (size (int_in%p_is_known)))
	int_out%p_is_known = int_in%p_is_known
	end if
	if (allocated (int_in%p)) then
	allocate (int_out%p (size (int_in%p)))
	int_out%p = int_in%p
	end if
	if (allocated (int_in%source)) then
	allocate (int_out%source (size (int_in%source)))
	int_out%source = int_in%source
	end if
	if (allocated (int_in%parents)) then
	allocate (int_out%parents (size (int_in%parents)))
	int_out%parents = int_in%parents
	end if
	if (allocated (int_in%children)) then
	allocate (int_out%children (size (int_in%children)))
	int_out%children = int_in%children
	end if
	if (allocated (int_in%resonant)) then
	allocate (int_out%resonant (size (int_in%resonant)))
	int_out%resonant = int_in%resonant
	end if
	if (allocated (int_in%mask)) then
	allocate (int_out%mask (size (int_in%mask)))
	int_out%mask = int_in%mask
	end if
	if (allocated (int_in%hel_lock)) then
	allocate (int_out%hel_lock (size (int_in%hel_lock)))
	int_out%hel_lock = int_in%hel_lock
	end if
	int_out%update_state_matrix = int_in%update_state_matrix
	int_out%update_values = int_in%update_values
	end subroutine interaction_assign

	@ %def interaction_assign
	@
	\subsection{Methods inherited from the state matrix member}
	Until F2003 is standard, we cannot implement inheritance directly.
	Therefore, we need wrappers for ``inherited'' methods.

	Make a new branch in the state matrix if it does not yet exist. This
	is not just a wrapper but it introduces the interaction mask: where a
	quantum number is masked, it is not transferred but set undefined.
	After this, the value array has to be updated.
	<<Interactions: interaction: TBP>>=
	procedure :: add_state => interaction_add_state
	<<Interactions: sub interfaces>>=
	module subroutine interaction_add_state &
	(int, qn, index, value, sum_values, counter_index, ignore_sub_for_qn, me_index)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer, intent(in), optional :: index
	complex(default), intent(in), optional :: value
	logical, intent(in), optional :: sum_values
	integer, intent(in), optional :: counter_index
	logical, intent(in), optional :: ignore_sub_for_qn
	integer, intent(out), optional :: me_index
	end subroutine interaction_add_state
	<<Interactions: procedures>>=
	module subroutine interaction_add_state &
	(int, qn, index, value, sum_values, counter_index, ignore_sub_for_qn, me_index)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer, intent(in), optional :: index
	complex(default), intent(in), optional :: value
	logical, intent(in), optional :: sum_values
	integer, intent(in), optional :: counter_index
	logical, intent(in), optional :: ignore_sub_for_qn
	integer, intent(out), optional :: me_index
	type(quantum_numbers_t), dimension(size(qn)) :: qn_tmp
	qn_tmp = qn
	call qn_tmp%undefine (int%mask)
	call int%state_matrix%add_state (qn_tmp, index, value, sum_values, &
	counter_index, ignore_sub_for_qn, me_index)
	int%update_values = .true.
	end subroutine interaction_add_state

	@ %def interaction_add_state
	@
	<<Interactions: interaction: TBP>>=
	procedure :: set_duplicate_flv_zero => interaction_set_duplicate_flv_zero
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_duplicate_flv_zero (int)
	class(interaction_t), intent(inout) :: int
	end subroutine interaction_set_duplicate_flv_zero
	<<Interactions: procedures>>=
	module subroutine interaction_set_duplicate_flv_zero (int)
	class(interaction_t), intent(inout) :: int
	call int%state_matrix%set_duplicate_flv_zero ()
	end subroutine interaction_set_duplicate_flv_zero

	@ %def interaction_set_duplicate_flv_zero
	@ Freeze the quantum state: First collapse the quantum state, i.e.,
	remove quantum numbers if any mask has changed, then fix the array of
	value pointers.
	<<Interactions: interaction: TBP>>=
	procedure :: freeze => interaction_freeze
	<<Interactions: sub interfaces>>=
	module subroutine interaction_freeze (int)
	class(interaction_t), intent(inout) :: int
	end subroutine interaction_freeze
	<<Interactions: procedures>>=
	module subroutine interaction_freeze (int)
	class(interaction_t), intent(inout) :: int
	if (int%update_state_matrix) then
	call int%state_matrix%collapse (int%mask)
	int%update_state_matrix = .false.
	int%update_values = .true.
	end if
	if (int%update_values) then
	call int%state_matrix%freeze ()
	int%update_values = .false.
	end if
	end subroutine interaction_freeze

	@ %def interaction_freeze
	@ Return true if the state matrix is empty.
	<<Interactions: interaction: TBP>>=
	procedure :: is_empty => interaction_is_empty
	<<Interactions: sub interfaces>>=
	pure module function interaction_is_empty (int) result (flag)
	logical :: flag
	class(interaction_t), intent(in) :: int
	end function interaction_is_empty
	<<Interactions: procedures>>=
	pure module function interaction_is_empty (int) result (flag)
	logical :: flag
	class(interaction_t), intent(in) :: int
	flag = int%state_matrix%is_empty ()
	end function interaction_is_empty

	@ %def interaction_is_empty
	@ Get the number of values stored in the state matrix:
	<<Interactions: interaction: TBP>>=
	procedure :: get_n_matrix_elements => &
	interaction_get_n_matrix_elements
	<<Interactions: sub interfaces>>=
	pure module function interaction_get_n_matrix_elements (int) result (n)
	integer :: n
	class(interaction_t), intent(in) :: int
	end function interaction_get_n_matrix_elements
	<<Interactions: procedures>>=
	pure module function interaction_get_n_matrix_elements (int) result (n)
	integer :: n
	class(interaction_t), intent(in) :: int
	n = int%state_matrix%get_n_matrix_elements ()
	end function interaction_get_n_matrix_elements

	@ %def interaction_get_n_matrix_elements
	@
	<<Interactions: interaction: TBP>>=
	procedure :: get_state_depth => interaction_get_state_depth
	<<Interactions: sub interfaces>>=
	module function interaction_get_state_depth (int) result (n)
	integer :: n
	class(interaction_t), intent(in) :: int
	end function interaction_get_state_depth
	<<Interactions: procedures>>=
	module function interaction_get_state_depth (int) result (n)
	integer :: n
	class(interaction_t), intent(in) :: int
	n = int%state_matrix%get_depth ()
	end function interaction_get_state_depth

	@ %def interaction_get_state_depth
	@
	<<Interactions: interaction: TBP>>=
	procedure :: get_n_in_helicities => interaction_get_n_in_helicities
	<<Interactions: sub interfaces>>=
	module function interaction_get_n_in_helicities (int) result (n_hel)
	integer :: n_hel
	class(interaction_t), intent(in) :: int
	end function interaction_get_n_in_helicities
	<<Interactions: procedures>>=
	module function interaction_get_n_in_helicities (int) result (n_hel)
	integer :: n_hel
	class(interaction_t), intent(in) :: int
	type(interaction_t) :: int_copy
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	integer :: i
	allocate (qn_mask (int%n_tot))
	do i = 1, int%n_tot
	if (i <= int%n_in) then
	call qn_mask(i)%init (.true., .true., .false.)
	else
	call qn_mask(i)%init (.true., .true., .true.)
	end if
	end do
	int_copy = int
	call int_copy%set_mask (qn_mask)
	call int_copy%freeze ()
	allocate (qn (int_copy%state_matrix%get_n_matrix_elements (), &
	int_copy%state_matrix%get_depth ()))
	qn = int_copy%get_quantum_numbers ()
	n_hel = 0
	do i = 1, size (qn, dim=1)
	if (all (qn(:, i)%get_subtraction_index () == 0)) n_hel = n_hel + 1
	end do
	call int_copy%final ()
	deallocate (qn_mask)
	deallocate (qn)
	end function interaction_get_n_in_helicities

	@ %def interaction_get_n_in_helicities
	@ Get the size of the [[me]]-array of the associated state matrix
	for debugging purposes
	<<Interactions: interaction: TBP>>=
	procedure :: get_me_size => interaction_get_me_size
	<<Interactions: sub interfaces>>=
	pure module function interaction_get_me_size (int) result (n)
	integer :: n
	class(interaction_t), intent(in) :: int
	end function interaction_get_me_size
	<<Interactions: procedures>>=
	pure module function interaction_get_me_size (int) result (n)
	integer :: n
	class(interaction_t), intent(in) :: int
	n = int%state_matrix%get_me_size ()
	end function interaction_get_me_size

	@ %def interaction_get_me_size
	@ Get the norm of the state matrix (if the norm has been taken out, otherwise
	this would be unity).
	<<Interactions: interaction: TBP>>=
	procedure :: get_norm => interaction_get_norm
	<<Interactions: sub interfaces>>=
	pure module function interaction_get_norm (int) result (norm)
	real(default) :: norm
	class(interaction_t), intent(in) :: int
	end function interaction_get_norm
	<<Interactions: procedures>>=
	pure module function interaction_get_norm (int) result (norm)
	real(default) :: norm
	class(interaction_t), intent(in) :: int
	norm = int%state_matrix%get_norm ()
	end function interaction_get_norm

	@ %def interaction_get_norm
	@
	<<Interactions: interaction: TBP>>=
	procedure :: get_n_sub => interaction_get_n_sub
	<<Interactions: sub interfaces>>=
	module function interaction_get_n_sub (int) result (n_sub)
	integer :: n_sub
	class(interaction_t), intent(in) :: int
	end function interaction_get_n_sub
	<<Interactions: procedures>>=
	module function interaction_get_n_sub (int) result (n_sub)
	integer :: n_sub
	class(interaction_t), intent(in) :: int
	n_sub = int%state_matrix%get_n_sub ()
	end function interaction_get_n_sub

	@ %def interaction_get_n_sub
	@ Get the quantum number array that corresponds to a given index.
	<<Interactions: interaction: TBP>>=
	generic :: get_quantum_numbers => get_quantum_numbers_single, &
	get_quantum_numbers_all, &
	get_quantum_numbers_all_qn_mask
	procedure :: get_quantum_numbers_single => &
	interaction_get_quantum_numbers_single
	procedure :: get_quantum_numbers_all => &
	interaction_get_quantum_numbers_all
	procedure :: get_quantum_numbers_all_qn_mask => &
	interaction_get_quantum_numbers_all_qn_mask
	<<Interactions: sub interfaces>>=
	module function interaction_get_quantum_numbers_single (int, i, by_me_index) result (qn)
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	class(interaction_t), intent(in), target :: int
	integer, intent(in) :: i
	logical, intent(in), optional :: by_me_index
	end function interaction_get_quantum_numbers_single
	module function interaction_get_quantum_numbers_all (int) result (qn)
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	class(interaction_t), intent(in), target :: int
	end function interaction_get_quantum_numbers_all
	module function interaction_get_quantum_numbers_all_qn_mask (int, qn_mask) &
	result (qn)
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	class(interaction_t), intent(in) :: int
	type(quantum_numbers_mask_t), intent(in) :: qn_mask
	end function interaction_get_quantum_numbers_all_qn_mask
	<<Interactions: procedures>>=
	module function interaction_get_quantum_numbers_single (int, i, by_me_index) result (qn)
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	class(interaction_t), intent(in), target :: int
	integer, intent(in) :: i
	logical, intent(in), optional :: by_me_index
	allocate (qn (int%state_matrix%get_depth ()))
	qn = int%state_matrix%get_quantum_number (i, by_me_index)
	end function interaction_get_quantum_numbers_single

	module function interaction_get_quantum_numbers_all (int) result (qn)
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	class(interaction_t), intent(in), target :: int
	integer :: i
	<<Interactions: get quantum numbers all>>
	<<Interactions: get quantum numbers all>>=
	allocate (qn (int%state_matrix%get_depth(), &
	int%state_matrix%get_n_matrix_elements ()))
	do i = 1, int%state_matrix%get_n_matrix_elements ()
	qn (:, i) = int%state_matrix%get_quantum_number (i)
	end do
	<<Interactions: procedures>>=
	end function interaction_get_quantum_numbers_all

	module function interaction_get_quantum_numbers_all_qn_mask (int, qn_mask) &
	result (qn)
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	class(interaction_t), intent(in) :: int
	type(quantum_numbers_mask_t), intent(in) :: qn_mask
	integer :: n_redundant, n_all, n_me
	integer :: i
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn_all
	<<Interactions: get quantum numbers all qn mask>>
	<<Interactions: get quantum numbers all qn mask>>=
	call int%state_matrix%get_quantum_numbers (qn_all)
	n_redundant = count (qn_all%are_redundant (qn_mask))
	n_all = size (qn_all)
	!!! Number of matrix elements = survivors / n_particles
	n_me = (n_all - n_redundant) / int%state_matrix%get_depth ()
	allocate (qn (int%state_matrix%get_depth(), n_me))
	do i = 1, n_me
	if (.not. any (qn_all(i, :)%are_redundant (qn_mask))) &
	qn (:, i) = qn_all (i, :)
	end do
	<<Interactions: procedures>>=
	end function interaction_get_quantum_numbers_all_qn_mask

	@ %def interaction_get_quantum_numbers_single
	@ %def interaction_get_quantum_numbers_all
	@ %def interaction_get_quantum_numbers_all_qn_mask
	@
	@
	<<Interactions: interaction: TBP>>=
	procedure :: get_quantum_numbers_all_sub => interaction_get_quantum_numbers_all_sub
	<<Interactions: sub interfaces>>=
	module subroutine interaction_get_quantum_numbers_all_sub (int, qn)
	class(interaction_t), intent(in) :: int
	type(quantum_numbers_t), dimension(:,:), allocatable, intent(out) :: qn
	end subroutine interaction_get_quantum_numbers_all_sub
	<<Interactions: procedures>>=
	module subroutine interaction_get_quantum_numbers_all_sub (int, qn)
	class(interaction_t), intent(in) :: int
	type(quantum_numbers_t), dimension(:,:), allocatable, intent(out) :: qn
	integer :: i
	<<Interactions: get quantum numbers all>>
	end subroutine interaction_get_quantum_numbers_all_sub

	@ %def interaction_get_quantum_numbers_all
	@
	<<Interactions: interaction: TBP>>=
	procedure :: get_flavors => interaction_get_flavors
	<<Interactions: sub interfaces>>=
	module subroutine interaction_get_flavors (int, only_elementary, qn_mask, flv)
	class(interaction_t), intent(in), target :: int
	logical, intent(in) :: only_elementary
	type(quantum_numbers_mask_t), intent(in), dimension(:), optional :: qn_mask
	integer, intent(out), dimension(:,:), allocatable :: flv
	end subroutine interaction_get_flavors
	<<Interactions: procedures>>=
	module subroutine interaction_get_flavors (int, only_elementary, qn_mask, flv)
	class(interaction_t), intent(in), target :: int
	logical, intent(in) :: only_elementary
	type(quantum_numbers_mask_t), intent(in), dimension(:), optional :: qn_mask
	integer, intent(out), dimension(:,:), allocatable :: flv
	call int%state_matrix%get_flavors (only_elementary, qn_mask, flv)
	end subroutine interaction_get_flavors

	@ %def interaction_get_flavors
	@
	<<Interactions: interaction: TBP>>=
	procedure :: get_quantum_numbers_mask => interaction_get_quantum_numbers_mask
	<<Interactions: sub interfaces>>=
	module subroutine interaction_get_quantum_numbers_mask (int, qn_mask, qn)
	class(interaction_t), intent(in) :: int
	type(quantum_numbers_mask_t), intent(in) :: qn_mask
	type(quantum_numbers_t), dimension(:,:), allocatable, intent(out) :: qn
	end subroutine interaction_get_quantum_numbers_mask
	<<Interactions: procedures>>=
	module subroutine interaction_get_quantum_numbers_mask (int, qn_mask, qn)
	class(interaction_t), intent(in) :: int
	type(quantum_numbers_mask_t), intent(in) :: qn_mask
	type(quantum_numbers_t), dimension(:,:), allocatable, intent(out) :: qn
	integer :: n_redundant, n_all, n_me
	integer :: i
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn_all
	<<Interactions: get quantum numbers all qn mask>>
	end subroutine interaction_get_quantum_numbers_mask

	@ %def interaction_get_quantum_numbers_mask
	@ Get the matrix element that corresponds to a set of quantum
	numbers, a given index, or return the whole array.
	<<Interactions: interaction: TBP>>=
	generic :: get_matrix_element => get_matrix_element_single
	generic :: get_matrix_element => get_matrix_element_array
	procedure :: get_matrix_element_single => &
	interaction_get_matrix_element_single
	procedure :: get_matrix_element_array => &
	interaction_get_matrix_element_array
	<<Interactions: sub interfaces>>=
	elemental module function interaction_get_matrix_element_single (int, i) result (me)
	complex(default) :: me
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	end function interaction_get_matrix_element_single
	<<Interactions: procedures>>=
	elemental module function interaction_get_matrix_element_single (int, i) result (me)
	complex(default) :: me
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	me = int%state_matrix%get_matrix_element (i)
	end function interaction_get_matrix_element_single

	@ %def interaction_get_matrix_element_single
	<<Interactions: sub interfaces>>=
	module function interaction_get_matrix_element_array (int) result (me)
	complex(default), dimension(:), allocatable :: me
	class(interaction_t), intent(in) :: int
	end function interaction_get_matrix_element_array
	<<Interactions: procedures>>=
	module function interaction_get_matrix_element_array (int) result (me)
	complex(default), dimension(:), allocatable :: me
	class(interaction_t), intent(in) :: int
	allocate (me (int%get_n_matrix_elements ()))
	me = int%state_matrix%get_matrix_element ()
	end function interaction_get_matrix_element_array

	@ %def interaction_get_matrix_element_array
	@ Set the complex value(s) stored in the quantum state.
	<<Interactions: interaction: TBP>>=
	generic :: set_matrix_element => interaction_set_matrix_element_qn, &
	interaction_set_matrix_element_all, &
	interaction_set_matrix_element_array, &
	interaction_set_matrix_element_single, &
	interaction_set_matrix_element_clone
	procedure :: interaction_set_matrix_element_qn
	procedure :: interaction_set_matrix_element_all
	procedure :: interaction_set_matrix_element_array
	procedure :: interaction_set_matrix_element_single
	procedure :: interaction_set_matrix_element_clone
	@ %def interaction_set_matrix_element
	@ Indirect access via the quantum number array:
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_matrix_element_qn (int, qn, val)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	complex(default), intent(in) :: val
	end subroutine interaction_set_matrix_element_qn
	<<Interactions: procedures>>=
	module subroutine interaction_set_matrix_element_qn (int, qn, val)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	complex(default), intent(in) :: val
	call int%state_matrix%set_matrix_element (qn, val)
	end subroutine interaction_set_matrix_element_qn

	@ %def interaction_set_matrix_element
	@ Set all entries of the matrix-element array to a given value.
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_matrix_element_all (int, value)
	class(interaction_t), intent(inout) :: int
	complex(default), intent(in) :: value
	end subroutine interaction_set_matrix_element_all
	<<Interactions: procedures>>=
	module subroutine interaction_set_matrix_element_all (int, value)
	class(interaction_t), intent(inout) :: int
	complex(default), intent(in) :: value
	call int%state_matrix%set_matrix_element (value)
	end subroutine interaction_set_matrix_element_all

	@ %def interaction_set_matrix_element_all
	@ Set the matrix-element array directly.
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_matrix_element_array (int, value, range)
	class(interaction_t), intent(inout) :: int
	complex(default), intent(in), dimension(:) :: value
	integer, intent(in), dimension(:), optional :: range
	end subroutine interaction_set_matrix_element_array
	pure module subroutine interaction_set_matrix_element_single (int, i, value)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	complex(default), intent(in) :: value
	end subroutine interaction_set_matrix_element_single
	<<Interactions: procedures>>=
	module subroutine interaction_set_matrix_element_array (int, value, range)
	class(interaction_t), intent(inout) :: int
	complex(default), intent(in), dimension(:) :: value
	integer, intent(in), dimension(:), optional :: range
	call int%state_matrix%set_matrix_element (value, range)
	end subroutine interaction_set_matrix_element_array

	pure module subroutine interaction_set_matrix_element_single (int, i, value)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	complex(default), intent(in) :: value
	call int%state_matrix%set_matrix_element (i, value)
	end subroutine interaction_set_matrix_element_single

	@ %def interaction_set_matrix_element_array
	@ %def interaction_set_matrix_element_single
	@ Clone from another (matching) interaction.
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_matrix_element_clone (int, int1)
	class(interaction_t), intent(inout) :: int
	class(interaction_t), intent(in) :: int1
	end subroutine interaction_set_matrix_element_clone
	<<Interactions: procedures>>=
	module subroutine interaction_set_matrix_element_clone (int, int1)
	class(interaction_t), intent(inout) :: int
	class(interaction_t), intent(in) :: int1
	call int%state_matrix%set_matrix_element (int1%state_matrix)
	end subroutine interaction_set_matrix_element_clone

	@ %def interaction_set_matrix_element_clone
	@
	<<Interactions: interaction: TBP>>=
	procedure :: set_only_matrix_element => interaction_set_only_matrix_element
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_only_matrix_element (int, i, value)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	complex(default), intent(in) :: value
	end subroutine interaction_set_only_matrix_element
	<<Interactions: procedures>>=
	module subroutine interaction_set_only_matrix_element (int, i, value)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	complex(default), intent(in) :: value
	call int%set_matrix_element (cmplx (0, 0, default))
	call int%set_matrix_element (i, value)
	end subroutine interaction_set_only_matrix_element

	@ %def interaction_set_only_matrix_element
	@
	<<Interactions: interaction: TBP>>=
	procedure :: add_to_matrix_element => interaction_add_to_matrix_element
	<<Interactions: sub interfaces>>=
	module subroutine interaction_add_to_matrix_element (int, qn, value, match_only_flavor)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	complex(default), intent(in) :: value
	logical, intent(in), optional :: match_only_flavor
	end subroutine interaction_add_to_matrix_element
	<<Interactions: procedures>>=
	module subroutine interaction_add_to_matrix_element (int, qn, value, match_only_flavor)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	complex(default), intent(in) :: value
	logical, intent(in), optional :: match_only_flavor
	call int%state_matrix%add_to_matrix_element (qn, value, match_only_flavor)
	end subroutine interaction_add_to_matrix_element

	@ %def interaction_add_to_matrix_element
	@ Get the indices of any diagonal matrix elements.
	<<Interactions: interaction: TBP>>=
	procedure :: get_diagonal_entries => interaction_get_diagonal_entries
	<<Interactions: sub interfaces>>=
	module subroutine interaction_get_diagonal_entries (int, i)
	class(interaction_t), intent(in) :: int
	integer, dimension(:), allocatable, intent(out) :: i
	end subroutine interaction_get_diagonal_entries
	<<Interactions: procedures>>=
	module subroutine interaction_get_diagonal_entries (int, i)
	class(interaction_t), intent(in) :: int
	integer, dimension(:), allocatable, intent(out) :: i
	call int%state_matrix%get_diagonal_entries (i)
	end subroutine interaction_get_diagonal_entries

	@ %def interaction_get_diagonal_entries
	@ Renormalize the state matrix by its trace, if nonzero. The renormalization
	is reflected in the state-matrix norm.
	<<Interactions: interaction: TBP>>=
	procedure :: normalize_by_trace => interaction_normalize_by_trace
	<<Interactions: sub interfaces>>=
	module subroutine interaction_normalize_by_trace (int)
	class(interaction_t), intent(inout) :: int
	end subroutine interaction_normalize_by_trace
	<<Interactions: procedures>>=
	module subroutine interaction_normalize_by_trace (int)
	class(interaction_t), intent(inout) :: int
	call int%state_matrix%normalize_by_trace ()
	end subroutine interaction_normalize_by_trace

	@ %def interaction_normalize_by_trace
	@ Analogous, but renormalize by maximal (absolute) value.
	<<Interactions: interaction: TBP>>=
	procedure :: normalize_by_max => interaction_normalize_by_max
	<<Interactions: sub interfaces>>=
	module subroutine interaction_normalize_by_max (int)
	class(interaction_t), intent(inout) :: int
	end subroutine interaction_normalize_by_max
	<<Interactions: procedures>>=
	module subroutine interaction_normalize_by_max (int)
	class(interaction_t), intent(inout) :: int
	call int%state_matrix%normalize_by_max ()
	end subroutine interaction_normalize_by_max

	@ %def interaction_normalize_by_max
	@ Explicitly set the norm value (of the state matrix).
	<<Interactions: interaction: TBP>>=
	procedure :: set_norm => interaction_set_norm
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_norm (int, norm)
	class(interaction_t), intent(inout) :: int
	real(default), intent(in) :: norm
	end subroutine interaction_set_norm
	<<Interactions: procedures>>=
	module subroutine interaction_set_norm (int, norm)
	class(interaction_t), intent(inout) :: int
	real(default), intent(in) :: norm
	call int%state_matrix%set_norm (norm)
	end subroutine interaction_set_norm

	@ %def interaction_set_norm
	@
	<<Interactions: interaction: TBP>>=
	procedure :: set_state_matrix => interaction_set_state_matrix
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_state_matrix (int, state)
	class(interaction_t), intent(inout) :: int
	type(state_matrix_t), intent(in) :: state
	end subroutine interaction_set_state_matrix
	<<Interactions: procedures>>=
	module subroutine interaction_set_state_matrix (int, state)
	class(interaction_t), intent(inout) :: int
	type(state_matrix_t), intent(in) :: state
	int%state_matrix = state
	end subroutine interaction_set_state_matrix

	@ %def interaction_set_state_matrix
	@ Return the maximum absolute value of color indices.
	<<Interactions: interaction: TBP>>=
	procedure :: get_max_color_value => &
	interaction_get_max_color_value
	<<Interactions: sub interfaces>>=
	module function interaction_get_max_color_value (int) result (cmax)
	class(interaction_t), intent(in) :: int
	integer :: cmax
	end function interaction_get_max_color_value
	<<Interactions: procedures>>=
	module function interaction_get_max_color_value (int) result (cmax)
	class(interaction_t), intent(in) :: int
	integer :: cmax
	cmax = int%state_matrix%get_max_color_value ()
	end function interaction_get_max_color_value

	@ %def interaction_get_max_color_value
	@ Factorize the state matrix into single-particle state matrices, the
	branch selection depending on a (random) value between 0 and 1;
	optionally also return a correlated state matrix.
	<<Interactions: interaction: TBP>>=
	procedure :: factorize => interaction_factorize
	<<Interactions: sub interfaces>>=
	module subroutine interaction_factorize &
	(int, mode, x, ok, single_state, correlated_state, qn_in)
	class(interaction_t), intent(in), target :: int
	integer, intent(in) :: mode
	real(default), intent(in) :: x
	logical, intent(out) :: ok
	type(state_matrix_t), &
	dimension(:), allocatable, intent(out) :: single_state
	type(state_matrix_t), intent(out), optional :: correlated_state
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_in
	end subroutine interaction_factorize
	<<Interactions: procedures>>=
	module subroutine interaction_factorize &
	(int, mode, x, ok, single_state, correlated_state, qn_in)
	class(interaction_t), intent(in), target :: int
	integer, intent(in) :: mode
	real(default), intent(in) :: x
	logical, intent(out) :: ok
	type(state_matrix_t), &
	dimension(:), allocatable, intent(out) :: single_state
	type(state_matrix_t), intent(out), optional :: correlated_state
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_in
	call int%state_matrix%factorize &
	(mode, x, ok, single_state, correlated_state, qn_in)
	end subroutine interaction_factorize

	@ %def interaction_factorize
	@ Sum all matrix element values
	<<Interactions: interaction: TBP>>=
	procedure :: sum => interaction_sum
	<<Interactions: sub interfaces>>=
	module function interaction_sum (int) result (value)
	class(interaction_t), intent(in) :: int
	complex(default) :: value
	end function interaction_sum
	<<Interactions: procedures>>=
	module function interaction_sum (int) result (value)
	class(interaction_t), intent(in) :: int
	complex(default) :: value
	value = int%state_matrix%sum ()
	end function interaction_sum

	@ %def interaction_sum
	@ Append new states which are color-contracted versions of the
	existing states. The matrix element index of each color contraction
	coincides with the index of its origin, so no new matrix elements are
	generated. After this operation, no [[freeze]] must be performed
	anymore.
	<<Interactions: interaction: TBP>>=
	procedure :: add_color_contractions => &
	interaction_add_color_contractions
	<<Interactions: sub interfaces>>=
	module subroutine interaction_add_color_contractions (int)
	class(interaction_t), intent(inout) :: int
	end subroutine interaction_add_color_contractions
	<<Interactions: procedures>>=
	module subroutine interaction_add_color_contractions (int)
	class(interaction_t), intent(inout) :: int
	call int%state_matrix%add_color_contractions ()
	end subroutine interaction_add_color_contractions

	@ %def interaction_add_color_contractions
	@ Multiply matrix elements from two interactions. Choose the elements
	as given by the integer index arrays, multiply them and store the sum
	of products in the indicated matrix element. The suffixes mean:
	c=conjugate first factor; f=include weighting factor.
	<<Interactions: interaction: TBP>>=
	procedure :: evaluate_product => interaction_evaluate_product
	procedure :: evaluate_product_cf => interaction_evaluate_product_cf
	procedure :: evaluate_square_c => interaction_evaluate_square_c
	procedure :: evaluate_sum => interaction_evaluate_sum
	procedure :: evaluate_me_sum => interaction_evaluate_me_sum
	<<Interactions: sub interfaces>>=
	pure module subroutine interaction_evaluate_product &
	(int, i, int1, int2, index1, index2)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(in) :: int1, int2
	integer, dimension(:), intent(in) :: index1, index2
	end subroutine interaction_evaluate_product
	pure module subroutine interaction_evaluate_product_cf &
	(int, i, int1, int2, index1, index2, factor)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(in) :: int1, int2
	integer, dimension(:), intent(in) :: index1, index2
	complex(default), dimension(:), intent(in) :: factor
	end subroutine interaction_evaluate_product_cf
	pure module subroutine interaction_evaluate_square_c (int, i, int1, index1)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(in) :: int1
	integer, dimension(:), intent(in) :: index1
	end subroutine interaction_evaluate_square_c
	pure module subroutine interaction_evaluate_sum (int, i, int1, index1)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(in) :: int1
	integer, dimension(:), intent(in) :: index1
	end subroutine interaction_evaluate_sum
	pure module subroutine interaction_evaluate_me_sum (int, i, int1, index1)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(in) :: int1
	integer, dimension(:), intent(in) :: index1
	end subroutine interaction_evaluate_me_sum
	<<Interactions: procedures>>=
	pure module subroutine interaction_evaluate_product &
	(int, i, int1, int2, index1, index2)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(in) :: int1, int2
	integer, dimension(:), intent(in) :: index1, index2
	call int%state_matrix%evaluate_product &
	(i, int1%state_matrix, int2%state_matrix, &
	index1, index2)
	end subroutine interaction_evaluate_product

	pure module subroutine interaction_evaluate_product_cf &
	(int, i, int1, int2, index1, index2, factor)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(in) :: int1, int2
	integer, dimension(:), intent(in) :: index1, index2
	complex(default), dimension(:), intent(in) :: factor
	call int%state_matrix%evaluate_product_cf &
	(i, int1%state_matrix, int2%state_matrix, &
	index1, index2, factor)
	end subroutine interaction_evaluate_product_cf

	pure module subroutine interaction_evaluate_square_c (int, i, int1, index1)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(in) :: int1
	integer, dimension(:), intent(in) :: index1
	call int%state_matrix%evaluate_square_c (i, int1%state_matrix, index1)
	end subroutine interaction_evaluate_square_c

	pure module subroutine interaction_evaluate_sum (int, i, int1, index1)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(in) :: int1
	integer, dimension(:), intent(in) :: index1
	call int%state_matrix%evaluate_sum (i, int1%state_matrix, index1)
	end subroutine interaction_evaluate_sum

	pure module subroutine interaction_evaluate_me_sum (int, i, int1, index1)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(in) :: int1
	integer, dimension(:), intent(in) :: index1
	call int%state_matrix%evaluate_me_sum (i, int1%state_matrix, index1)
	end subroutine interaction_evaluate_me_sum

	@ %def interaction_evaluate_product
	@ %def interaction_evaluate_product_cf
	@ %def interaction_evaluate_square_c
	@ %def interaction_evaluate_sum
	@ %def interaction_evaluate_me_sum
	@ Tag quantum numbers of the state matrix as part of the hard process, according
	to the indices specified in [[tag]]. If no [[tag]] is given, all quantum numbers are
	tagged as part of the hard process.
	<<Interactions: interaction: TBP>>=
	procedure :: tag_hard_process => interaction_tag_hard_process
	<<Interactions: sub interfaces>>=
	module subroutine interaction_tag_hard_process (int, tag)
	class(interaction_t), intent(inout) :: int
	integer, dimension(:), intent(in), optional :: tag
	end subroutine interaction_tag_hard_process
	<<Interactions: procedures>>=
	module subroutine interaction_tag_hard_process (int, tag)
	class(interaction_t), intent(inout) :: int
	integer, dimension(:), intent(in), optional :: tag
	type(state_matrix_t) :: state
	call int%state_matrix%tag_hard_process (state, tag)
	call int%state_matrix%final ()
	int%state_matrix = state
	end subroutine interaction_tag_hard_process

	@ %def interaction_tag_hard_process
	@ Modify hard-interaction flags at the specified particle-position, in-place.
	<<Interactions: interaction: TBP>>=
	procedure :: retag_hard_process => interaction_retag_hard_process
	<<Interactions: sub interfaces>>=
	module subroutine interaction_retag_hard_process (int, i, hard)
	class(interaction_t), intent(inout), target :: int
	integer, intent(in) :: i
	logical, intent(in) :: hard
	end subroutine interaction_retag_hard_process
	<<Interactions: procedures>>=
	module subroutine interaction_retag_hard_process (int, i, hard)
	class(interaction_t), intent(inout), target :: int
	integer, intent(in) :: i
	logical, intent(in) :: hard
	type(state_iterator_t) :: it
	call it%init (int%get_state_matrix_ptr ())
	do while (it%is_valid ())
	call it%retag_hard_process (i, hard)
	call it%advance ()
	end do
	end subroutine interaction_retag_hard_process

	@ %def interaction_retag_hard_process
	@
	\subsection{Accessing contents}
	Return the integer tag.
	<<Interactions: interaction: TBP>>=
	procedure :: get_tag => interaction_get_tag
	<<Interactions: sub interfaces>>=
	module function interaction_get_tag (int) result (tag)
	class(interaction_t), intent(in) :: int
	integer :: tag
	end function interaction_get_tag
	<<Interactions: procedures>>=
	module function interaction_get_tag (int) result (tag)
	class(interaction_t), intent(in) :: int
	integer :: tag
	tag = int%tag
	end function interaction_get_tag

	@ %def interaction_get_tag
	@ Return the number of particles.
	<<Interactions: interaction: TBP>>=
	procedure :: get_n_tot => interaction_get_n_tot
	procedure :: get_n_in => interaction_get_n_in
	procedure :: get_n_vir => interaction_get_n_vir
	procedure :: get_n_out => interaction_get_n_out
	<<Interactions: sub interfaces>>=
	pure module function interaction_get_n_tot (object) result (n_tot)
	class(interaction_t), intent(in) :: object
	integer :: n_tot
	end function interaction_get_n_tot
	pure module function interaction_get_n_in (object) result (n_in)
	class(interaction_t), intent(in) :: object
	integer :: n_in
	end function interaction_get_n_in
	pure module function interaction_get_n_vir (object) result (n_vir)
	class(interaction_t), intent(in) :: object
	integer :: n_vir
	end function interaction_get_n_vir
	pure module function interaction_get_n_out (object) result (n_out)
	class(interaction_t), intent(in) :: object
	integer :: n_out
	end function interaction_get_n_out
	<<Interactions: procedures>>=
	pure module function interaction_get_n_tot (object) result (n_tot)
	class(interaction_t), intent(in) :: object
	integer :: n_tot
	n_tot = object%n_tot
	end function interaction_get_n_tot

	pure module function interaction_get_n_in (object) result (n_in)
	class(interaction_t), intent(in) :: object
	integer :: n_in
	n_in = object%n_in
	end function interaction_get_n_in

	pure module function interaction_get_n_vir (object) result (n_vir)
	class(interaction_t), intent(in) :: object
	integer :: n_vir
	n_vir = object%n_vir
	end function interaction_get_n_vir

	pure module function interaction_get_n_out (object) result (n_out)
	class(interaction_t), intent(in) :: object
	integer :: n_out
	n_out = object%n_out
	end function interaction_get_n_out

	@ %def interaction_get_n_tot
	@ %def interaction_get_n_in interaction_get_n_vir interaction_get_n_out
	@ Return a momentum index. The flags specify whether to keep/drop
	incoming, virtual, or outgoing momenta. Check for illegal values.
	<<Interactions: sub interfaces>>=
	module function idx (int, i, outgoing)
	integer :: idx
	type(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	logical, intent(in), optional :: outgoing
	end function idx
	<<Interactions: procedures>>=
	module function idx (int, i, outgoing)
	integer :: idx
	type(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	logical, intent(in), optional :: outgoing
	logical :: in, vir, out
	if (present (outgoing)) then
	in = .not. outgoing
	vir = .false.
	out = outgoing
	else
	in = .true.
	vir = .true.
	out = .true.
	end if
	idx = 0
	if (in) then
	if (vir) then
	if (out) then
	if (i <= int%n_tot) idx = i
	else
	if (i <= int%n_in + int%n_vir) idx = i
	end if
	else if (out) then
	if (i <= int%n_in) then
	idx = i
	else if (i <= int%n_in + int%n_out) then
	idx = int%n_vir + i
	end if
	else
	if (i <= int%n_in) idx = i
	end if
	else if (vir) then
	if (out) then
	if (i <= int%n_vir + int%n_out) idx = int%n_in + i
	else
	if (i <= int%n_vir) idx = int%n_in + i
	end if
	else if (out) then
	if (i <= int%n_out) idx = int%n_in + int%n_vir + i
	end if
	if (idx == 0) then
	call int%basic_write ()
	print *, i, in, vir, out
	call msg_bug (" Momentum index is out of range for this interaction")
	end if
	end function idx

	@ %def idx
	@ Return all or just a specific four-momentum.
	<<Interactions: interaction: TBP>>=
	generic :: get_momenta => get_momenta_all, get_momenta_idx
	procedure :: get_momentum => interaction_get_momentum
	procedure :: get_momenta_all => interaction_get_momenta_all
	procedure :: get_momenta_idx => interaction_get_momenta_idx
	<<Interactions: sub interfaces>>=
	module function interaction_get_momenta_all (int, outgoing) result (p)
	class(interaction_t), intent(in) :: int
	type(vector4_t), dimension(:), allocatable :: p
	logical, intent(in), optional :: outgoing
	end function interaction_get_momenta_all
	module function interaction_get_momenta_idx (int, jj) result (p)
	class(interaction_t), intent(in) :: int
	type(vector4_t), dimension(:), allocatable :: p
	integer, dimension(:), intent(in) :: jj
	end function interaction_get_momenta_idx
	module function interaction_get_momentum (int, i, outgoing) result (p)
	class(interaction_t), intent(in) :: int
	type(vector4_t) :: p
	integer, intent(in) :: i
	logical, intent(in), optional :: outgoing
	end function interaction_get_momentum
	<<Interactions: procedures>>=
	module function interaction_get_momenta_all (int, outgoing) result (p)
	class(interaction_t), intent(in) :: int
	type(vector4_t), dimension(:), allocatable :: p
	logical, intent(in), optional :: outgoing
	integer :: i
	if (present (outgoing)) then
	if (outgoing) then
	allocate (p (int%n_out))
	else
	allocate (p (int%n_in))
	end if
	else
	allocate (p (int%n_tot))
	end if
	do i = 1, size (p)
	p(i) = int%p(idx (int, i, outgoing))
	end do
	end function interaction_get_momenta_all

	module function interaction_get_momenta_idx (int, jj) result (p)
	class(interaction_t), intent(in) :: int
	type(vector4_t), dimension(:), allocatable :: p
	integer, dimension(:), intent(in) :: jj
	allocate (p (size (jj)))
	p = int%p(jj)
	end function interaction_get_momenta_idx

	module function interaction_get_momentum (int, i, outgoing) result (p)
	class(interaction_t), intent(in) :: int
	type(vector4_t) :: p
	integer, intent(in) :: i
	logical, intent(in), optional :: outgoing
	p = int%p(idx (int, i, outgoing))
	end function interaction_get_momentum

	@ %def interaction_get_momenta interaction_get_momentum
	@ Return a shallow copy of the state matrix:
	<<Interactions: interaction: TBP>>=
	procedure :: get_state_matrix_ptr => &
	interaction_get_state_matrix_ptr
	<<Interactions: sub interfaces>>=
	module function interaction_get_state_matrix_ptr (int) result (state)
	class(interaction_t), intent(in), target :: int
	type(state_matrix_t), pointer :: state
	end function interaction_get_state_matrix_ptr
	<<Interactions: procedures>>=
	module function interaction_get_state_matrix_ptr (int) result (state)
	class(interaction_t), intent(in), target :: int
	type(state_matrix_t), pointer :: state
	state => int%state_matrix
	end function interaction_get_state_matrix_ptr

	@ %def interaction_get_state_matrix_ptr
	@ Return the array of resonance flags
	<<Interactions: interaction: TBP>>=
	procedure :: get_resonance_flags => interaction_get_resonance_flags
	<<Interactions: sub interfaces>>=
	module function interaction_get_resonance_flags (int) result (resonant)
	class(interaction_t), intent(in) :: int
	logical, dimension(size(int%resonant)) :: resonant
	end function interaction_get_resonance_flags
	<<Interactions: procedures>>=
	module function interaction_get_resonance_flags (int) result (resonant)
	class(interaction_t), intent(in) :: int
	logical, dimension(size(int%resonant)) :: resonant
	resonant = int%resonant
	end function interaction_get_resonance_flags

	@ %def interaction_get_resonance_flags
	@ Return the quantum-numbers mask (or part of it)
	<<Interactions: interaction: TBP>>=
	generic :: get_mask => get_mask_all, get_mask_slice
	procedure :: get_mask_all => interaction_get_mask_all
	procedure :: get_mask_slice => interaction_get_mask_slice
	<<Interactions: sub interfaces>>=
	module function interaction_get_mask_all (int) result (mask)
	class(interaction_t), intent(in) :: int
	type(quantum_numbers_mask_t), dimension(size(int%mask)) :: mask
	end function interaction_get_mask_all
	module function interaction_get_mask_slice (int, index) result (mask)
	class(interaction_t), intent(in) :: int
	integer, dimension(:), intent(in) :: index
	type(quantum_numbers_mask_t), dimension(size(index)) :: mask
	end function interaction_get_mask_slice
	<<Interactions: procedures>>=
	module function interaction_get_mask_all (int) result (mask)
	class(interaction_t), intent(in) :: int
	type(quantum_numbers_mask_t), dimension(size(int%mask)) :: mask
	mask = int%mask
	end function interaction_get_mask_all

	module function interaction_get_mask_slice (int, index) result (mask)
	class(interaction_t), intent(in) :: int
	integer, dimension(:), intent(in) :: index
	type(quantum_numbers_mask_t), dimension(size(index)) :: mask
	mask = int%mask(index)
	end function interaction_get_mask_slice

	@ %def interaction_get_mask
	@ Compute the invariant mass squared of the incoming particles (if any,
	otherwise outgoing).
	<<Interactions: interaction: TBP>>=
	procedure :: get_s => interaction_get_s
	<<Interactions: sub interfaces>>=
	module function interaction_get_s (int) result (s)
	real(default) :: s
	class(interaction_t), intent(in) :: int
	end function interaction_get_s
	<<Interactions: procedures>>=
	module function interaction_get_s (int) result (s)
	real(default) :: s
	class(interaction_t), intent(in) :: int
	if (int%n_in /= 0) then
	s = sum (int%p(:int%n_in)) ** 2
	else
	s = sum (int%p(int%n_vir + 1 : )) ** 2
	end if
	end function interaction_get_s

	@ %def interaction_get_s
	@ Compute the Lorentz transformation that transforms the incoming
	particles from the center-of-mass frame to the lab frame where they
	are given. If the c.m. mass squared is negative or zero, return the
	identity.
	<<Interactions: interaction: TBP>>=
	procedure :: get_cm_transformation => interaction_get_cm_transformation
	<<Interactions: sub interfaces>>=
	module function interaction_get_cm_transformation (int) result (lt)
	type(lorentz_transformation_t) :: lt
	class(interaction_t), intent(in) :: int
	end function interaction_get_cm_transformation
	<<Interactions: procedures>>=
	module function interaction_get_cm_transformation (int) result (lt)
	type(lorentz_transformation_t) :: lt
	class(interaction_t), intent(in) :: int
	type(vector4_t) :: p_cm
	real(default) :: s
	if (int%n_in /= 0) then
	p_cm = sum (int%p(:int%n_in))
	else
	p_cm = sum (int%p(int%n_vir+1:))
	end if
	s = p_cm ** 2
	if (s > 0) then
	lt = boost (p_cm, sqrt (s))
	else
	lt = identity
	end if
	end function interaction_get_cm_transformation

	@ %def interaction_get_cm_transformation
	@ Return flavor, momentum, and position of the first outgoing
	unstable particle present in the interaction. Note that we need not
	iterate through the state matrix; if there is an unstable particle, it
	will be present in all state-matrix entries.
	<<Interactions: interaction: TBP>>=
	procedure :: get_unstable_particle => interaction_get_unstable_particle
	<<Interactions: sub interfaces>>=
	module subroutine interaction_get_unstable_particle (int, flv, p, i)
	class(interaction_t), intent(in), target :: int
	type(flavor_t), intent(out) :: flv
	type(vector4_t), intent(out) :: p
	integer, intent(out) :: i
	end subroutine interaction_get_unstable_particle
	<<Interactions: procedures>>=
	module subroutine interaction_get_unstable_particle (int, flv, p, i)
	class(interaction_t), intent(in), target :: int
	type(flavor_t), intent(out) :: flv
	type(vector4_t), intent(out) :: p
	integer, intent(out) :: i
	type(state_iterator_t) :: it
	type(flavor_t), dimension(int%n_tot) :: flv_array
	call it%init (int%state_matrix)
	flv_array = it%get_flavor ()
	do i = int%n_in + int%n_vir + 1, int%n_tot
	if (.not. flv_array(i)%is_stable ()) then
	flv = flv_array(i)
	p = int%p(i)
	return
	end if
	end do
	end subroutine interaction_get_unstable_particle

	@ %def interaction_get_unstable_particle
	@ Return the complete set of \emph{outgoing} flavors, assuming that
	the flavor quantum number is not suppressed.
	<<Interactions: interaction: TBP>>=
	procedure :: get_flv_out => interaction_get_flv_out
	<<Interactions: sub interfaces>>=
	module subroutine interaction_get_flv_out (int, flv)
	class(interaction_t), intent(in), target :: int
	type(flavor_t), dimension(:,:), allocatable, intent(out) :: flv
	end subroutine interaction_get_flv_out
	<<Interactions: procedures>>=
	module subroutine interaction_get_flv_out (int, flv)
	class(interaction_t), intent(in), target :: int
	type(flavor_t), dimension(:,:), allocatable, intent(out) :: flv
	type(state_iterator_t) :: it
	type(flavor_t), dimension(:), allocatable :: flv_state
	integer :: n_in, n_vir, n_out, n_tot, n_state, i
	n_in = int%get_n_in ()
	n_vir = int%get_n_vir ()
	n_out = int%get_n_out ()
	n_tot = int%get_n_tot ()
	n_state = int%get_n_matrix_elements ()
	allocate (flv (n_out, n_state))
	allocate (flv_state (n_tot))
	i = 1
	call it%init (int%get_state_matrix_ptr ())
	do while (it%is_valid ())
	flv_state = it%get_flavor ()
	flv(:,i) = flv_state(n_in + n_vir + 1 : )
	i = i + 1
	call it%advance ()
	end do
	end subroutine interaction_get_flv_out

	@ %def interaction_get_flv_out
	@ Determine the flavor content of the interaction. We analyze the
	state matrix for this, and we select the outgoing particles of the
	hard process only for the required mask, which indicates the particles
	that can appear in any order in a matching event record.

	We have to assume that any radiated particles (beam remnants) appear
	at the beginning of the particles marked as outgoing.
	<<Interactions: interaction: TBP>>=
	procedure :: get_flv_content => interaction_get_flv_content
	<<Interactions: sub interfaces>>=
	module subroutine interaction_get_flv_content (int, state_flv, n_out_hard)
	class(interaction_t), intent(in), target :: int
	type(state_flv_content_t), intent(out) :: state_flv
	integer, intent(in) :: n_out_hard
	end subroutine interaction_get_flv_content
	<<Interactions: procedures>>=
	module subroutine interaction_get_flv_content (int, state_flv, n_out_hard)
	class(interaction_t), intent(in), target :: int
	type(state_flv_content_t), intent(out) :: state_flv
	integer, intent(in) :: n_out_hard
	logical, dimension(:), allocatable :: mask
	integer :: n_tot
	n_tot = int%get_n_tot ()
	allocate (mask (n_tot), source = .false.)
	mask(n_tot-n_out_hard + 1 : ) = .true.
	call state_flv%fill (int%get_state_matrix_ptr (), mask)
	end subroutine interaction_get_flv_content

	@ %def interaction_get_flv_content
	@
	\subsection{Modifying contents}
	Set the quantum numbers mask.
	<<Interactions: interaction: TBP>>=
	procedure :: set_mask => interaction_set_mask
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_mask (int, mask)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	end subroutine interaction_set_mask
	<<Interactions: procedures>>=
	module subroutine interaction_set_mask (int, mask)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	if (size (int%mask) /= size (mask)) &
	call msg_fatal ("Attempting to set mask with unfitting size!")
	int%mask = mask
	int%update_state_matrix = .true.
	end subroutine interaction_set_mask

	@ %def interaction_set_mask
	@ Merge a particular mask entry, respecting a possible helicity lock for this
	entry. We apply an OR relation, which means that quantum numbers are
	summed over if either of the two masks requires it.
	<<Interactions: procedures>>=
	subroutine interaction_merge_mask_entry (int, i, mask)
	type(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(quantum_numbers_mask_t), intent(in) :: mask
	type(quantum_numbers_mask_t) :: mask_tmp
	integer :: ii
	ii = idx (int, i)
	if (int%mask(ii) .neqv. mask) then
	int%mask(ii) = int%mask(ii) .or. mask
	if (int%hel_lock(ii) /= 0) then
	call mask_tmp%assign (mask, helicity=.true.)
	int%mask(int%hel_lock(ii)) = int%mask(int%hel_lock(ii)) .or. mask_tmp
	end if
	end if
	int%update_state_matrix = .true.
	end subroutine interaction_merge_mask_entry

	@ %def interaction_merge_mask_entry
	@ Fill the momenta array, do not care about the quantum numbers of
	particles.
	<<Interactions: interaction: TBP>>=
	procedure :: reset_momenta => interaction_reset_momenta
	procedure :: set_momenta => interaction_set_momenta
	procedure :: set_momentum => interaction_set_momentum
	<<Interactions: sub interfaces>>=
	module subroutine interaction_reset_momenta (int)
	class(interaction_t), intent(inout) :: int
	end subroutine interaction_reset_momenta
	module subroutine interaction_set_momenta (int, p, outgoing)
	class(interaction_t), intent(inout) :: int
	type(vector4_t), dimension(:), intent(in) :: p
	logical, intent(in), optional :: outgoing
	end subroutine interaction_set_momenta
	module subroutine interaction_set_momentum (int, p, i, outgoing)
	class(interaction_t), intent(inout) :: int
	type(vector4_t), intent(in) :: p
	integer, intent(in) :: i
	logical, intent(in), optional :: outgoing
	end subroutine interaction_set_momentum
	<<Interactions: procedures>>=
	module subroutine interaction_reset_momenta (int)
	class(interaction_t), intent(inout) :: int
	int%p = vector4_null
	int%p_is_known = .true.
	end subroutine interaction_reset_momenta

	module subroutine interaction_set_momenta (int, p, outgoing)
	class(interaction_t), intent(inout) :: int
	type(vector4_t), dimension(:), intent(in) :: p
	logical, intent(in), optional :: outgoing
	integer :: i, index
	do i = 1, size (p)
	index = idx (int, i, outgoing)
	int%p(index) = p(i)
	int%p_is_known(index) = .true.
	end do
	end subroutine interaction_set_momenta

	module subroutine interaction_set_momentum (int, p, i, outgoing)
	class(interaction_t), intent(inout) :: int
	type(vector4_t), intent(in) :: p
	integer, intent(in) :: i
	logical, intent(in), optional :: outgoing
	integer :: index
	index = idx (int, i, outgoing)
	int%p(index) = p
	int%p_is_known(index) = .true.
	end subroutine interaction_set_momentum

	@ %def interaction_reset_momenta
	@ %def interaction_set_momenta interaction_set_momentum
	@ This more sophisticated version of setting values is used for
	structure functions, in particular if nontrivial flavor, color, and
	helicity may be present: set values selectively for the given flavors.
	If there is more than one flavor, scan the interaction and check for a
	matching flavor at the specified particle location. If it matches,
	insert the value that corresponds to this flavor.
	<<Interactions: interaction: TBP>>=
	procedure :: set_flavored_values => interaction_set_flavored_values
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_flavored_values (int, value, flv_in, pos)
	class(interaction_t), intent(inout) :: int
	complex(default), dimension(:), intent(in) :: value
	type(flavor_t), dimension(:), intent(in) :: flv_in
	integer, intent(in) :: pos
	end subroutine interaction_set_flavored_values
	<<Interactions: procedures>>=
	module subroutine interaction_set_flavored_values (int, value, flv_in, pos)
	class(interaction_t), intent(inout) :: int
	complex(default), dimension(:), intent(in) :: value
	type(flavor_t), dimension(:), intent(in) :: flv_in
	integer, intent(in) :: pos
	type(state_iterator_t) :: it
	type(flavor_t) :: flv
	integer :: i
	if (size (value) == 1) then
	call int%set_matrix_element (value(1))
	else
	call it%init (int%state_matrix)
	do while (it%is_valid ())
	flv = it%get_flavor (pos)
	SCAN_FLV: do i = 1, size (value)
	if (flv == flv_in(i)) then
	call it%set_matrix_element (value(i))
	exit SCAN_FLV
	end if
	end do SCAN_FLV
	call it%advance ()
	end do
	end if
	end subroutine interaction_set_flavored_values

	@ %def interaction_set_flavored_values
	@
	\subsection{Handling Linked interactions}
	Store relations between corresponding particles within one
	interaction. The first particle is the parent, the second one the
	child. Links are established in both directions.

	These relations have no effect on the propagation of momenta etc.,
	they are rather used for mother-daughter relations in event output.
	<<Interactions: interaction: TBP>>=
	procedure :: relate => interaction_relate
	<<Interactions: sub interfaces>>=
	module subroutine interaction_relate (int, i1, i2)
	class(interaction_t), intent(inout), target :: int
	integer, intent(in) :: i1, i2
	end subroutine interaction_relate
	<<Interactions: procedures>>=
	module subroutine interaction_relate (int, i1, i2)
	class(interaction_t), intent(inout), target :: int
	integer, intent(in) :: i1, i2
	if (i1 /= 0 .and. i2 /= 0) then
	call int%children(i1)%append (i2)
	call int%parents(i2)%append (i1)
	end if
	end subroutine interaction_relate

	@ %def interaction_relate
	@ Transfer internal parent-child relations defined within interaction
	[[int1]] to a new interaction [[int]] where the particle indices are
	mapped to. Some particles in [[int1]] may have no image in [[int]].
	In that case, a child entry maps to zero, and we skip this relation.

	Also transfer resonance flags.
	<<Interactions: interaction: TBP>>=
	procedure :: transfer_relations => interaction_transfer_relations
	<<Interactions: sub interfaces>>=
	module subroutine interaction_transfer_relations (int1, int2, map)
	class(interaction_t), intent(in) :: int1
	class(interaction_t), intent(inout), target :: int2
	integer, dimension(:), intent(in) :: map
	end subroutine interaction_transfer_relations
	<<Interactions: procedures>>=
	module subroutine interaction_transfer_relations (int1, int2, map)
	class(interaction_t), intent(in) :: int1
	class(interaction_t), intent(inout), target :: int2
	integer, dimension(:), intent(in) :: map
	integer :: i, j, k
	do i = 1, size (map)
	do j = 1, int1%parents(i)%get_length ()
	k = int1%parents(i)%get_link (j)
	call int2%relate (map(k), map(i))
	end do
	if (map(i) /= 0) then
	int2%resonant(map(i)) = int1%resonant(i)
	end if
	end do
	end subroutine interaction_transfer_relations

	@ %def interaction_transfer_relations
	@ Make up internal parent-child relations for the particle(s) that are
	connected to a new interaction [[int]].

	If [[resonant]] is defined and true, the connections are marked as
	resonant in the result interaction. Also, the children of the resonant
	connections are untagged if they were tagged with hard-interaction flags
	previously.
	<<Interactions: interaction: TBP>>=
	procedure :: relate_connections => interaction_relate_connections
	<<Interactions: sub interfaces>>=
	module subroutine interaction_relate_connections &
	(int, int_in, connection_index, &
	map, map_connections, resonant)
	class(interaction_t), intent(inout), target :: int
	class(interaction_t), intent(in) :: int_in
	integer, dimension(:), intent(in) :: connection_index
	integer, dimension(:), intent(in) :: map, map_connections
	logical, intent(in), optional :: resonant
	end subroutine interaction_relate_connections
	<<Interactions: procedures>>=
	module subroutine interaction_relate_connections &
	(int, int_in, connection_index, &
	map, map_connections, resonant)
	class(interaction_t), intent(inout), target :: int
	class(interaction_t), intent(in) :: int_in
	integer, dimension(:), intent(in) :: connection_index
	integer, dimension(:), intent(in) :: map, map_connections
	logical, intent(in), optional :: resonant
	logical :: reson
	integer :: i, j, i2, k2
	reson = .false.; if (present (resonant)) reson = resonant
	do i = 1, size (map_connections)
	k2 = connection_index(i)
	do j = 1, int_in%children(k2)%get_length ()
	i2 = int_in%children(k2)%get_link (j)
	call int%relate (map_connections(i), map(i2))
	if (reson) call int%retag_hard_process (map(i2), .false.)
	end do
	int%resonant(map_connections(i)) = reson
	end do
	end subroutine interaction_relate_connections

	@ %def interaction_relate_connections.
	@ Return the number of source/target links of the internal connections of
	particle [[i]].
	<<Interactions: interaction: TBP>>=
	procedure :: get_n_children => interaction_get_n_children
	procedure :: get_n_parents => interaction_get_n_parents
	<<Interactions: sub interfaces>>=
	module function interaction_get_n_children (int, i) result (n)
	integer :: n
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	end function interaction_get_n_children
	module function interaction_get_n_parents (int, i) result (n)
	integer :: n
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	end function interaction_get_n_parents
	<<Interactions: procedures>>=
	module function interaction_get_n_children (int, i) result (n)
	integer :: n
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	n = int%children(i)%get_length ()
	end function interaction_get_n_children

	module function interaction_get_n_parents (int, i) result (n)
	integer :: n
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	n = int%parents(i)%get_length ()
	end function interaction_get_n_parents

	@ %def interaction_get_n_children interaction_get_n_parents
	@ Return the source/target links of the internal connections of
	particle [[i]] as an array.
	<<Interactions: interaction: TBP>>=
	procedure :: get_children => interaction_get_children
	procedure :: get_parents => interaction_get_parents
	<<Interactions: sub interfaces>>=
	module function interaction_get_children (int, i) result (idx)
	integer, dimension(:), allocatable :: idx
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	end function interaction_get_children
	module function interaction_get_parents (int, i) result (idx)
	integer, dimension(:), allocatable :: idx
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	end function interaction_get_parents
	<<Interactions: procedures>>=
	module function interaction_get_children (int, i) result (idx)
	integer, dimension(:), allocatable :: idx
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	integer :: k, l
	l = int%children(i)%get_length ()
	allocate (idx (l))
	do k = 1, l
	idx(k) = int%children(i)%get_link (k)
	end do
	end function interaction_get_children

	module function interaction_get_parents (int, i) result (idx)
	integer, dimension(:), allocatable :: idx
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	integer :: k, l
	l = int%parents(i)%get_length ()
	allocate (idx (l))
	do k = 1, l
	idx(k) = int%parents(i)%get_link (k)
	end do
	end function interaction_get_parents

	@ %def interaction_get_children interaction_get_parents
	@ Add a source link from an interaction to a corresponding particle
	within another interaction. These links affect the propagation of
	particles: the two linked particles are considered as the same
	particle, outgoing and incoming.
	<<Interactions: interaction: TBP>>=
	procedure :: set_source_link => interaction_set_source_link
	<<Interactions: sub interfaces>>=
	module subroutine interaction_set_source_link (int, i, int1, i1)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	class(interaction_t), intent(in), target :: int1
	integer, intent(in) :: i1
	end subroutine interaction_set_source_link
	<<Interactions: procedures>>=
	module subroutine interaction_set_source_link (int, i, int1, i1)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	class(interaction_t), intent(in), target :: int1
	integer, intent(in) :: i1
	if (i /= 0) call external_link_set (int%source(i), int1, i1)
	end subroutine interaction_set_source_link

	@ %def interaction_set_source_link
	@ Reassign links to a new interaction (which is an image of the
	current interaction).
	<<Interactions: public>>=
	public :: interaction_reassign_links
	<<Interactions: sub interfaces>>=
	module subroutine interaction_reassign_links (int, int_src, int_target)
	type(interaction_t), intent(inout) :: int
	type(interaction_t), intent(in) :: int_src
	type(interaction_t), intent(in), target :: int_target
	end subroutine interaction_reassign_links
	<<Interactions: procedures>>=
	module subroutine interaction_reassign_links (int, int_src, int_target)
	type(interaction_t), intent(inout) :: int
	type(interaction_t), intent(in) :: int_src
	type(interaction_t), intent(in), target :: int_target
	integer :: i
	if (allocated (int%source)) then
	do i = 1, size (int%source)
	call external_link_reassign (int%source(i), int_src, int_target)
	end do
	end if
	end subroutine interaction_reassign_links

	@ %def interaction_reassign_links
	@ Since links are one-directional, if we want to follow them backwards
	we have to scan all possibilities. This procedure returns the index
	of the particle within [[int]] which points to the particle [[i1]]
	within interaction [[int1]]. If unsuccessful, return zero.
	<<Interactions: public>>=
	public :: interaction_find_link
	<<Interactions: sub interfaces>>=
	module function interaction_find_link (int, int1, i1) result (i)
	integer :: i
	type(interaction_t), intent(in) :: int, int1
	integer, intent(in) :: i1
	end function interaction_find_link
	<<Interactions: procedures>>=
	module function interaction_find_link (int, int1, i1) result (i)
	integer :: i
	type(interaction_t), intent(in) :: int, int1
	integer, intent(in) :: i1
	type(interaction_t), pointer :: int_tmp
	do i = 1, int%n_tot
	int_tmp => external_link_get_ptr (int%source(i))
	if (int_tmp%tag == int1%tag) then
	if (external_link_get_index (int%source(i)) == i1) return
	end if
	end do
	i = 0
	end function interaction_find_link

	@ %def interaction_find_link
	@ The inverse: return interaction pointer and index for the ultimate source of
	[[i]] within [[int]].
	<<Interactions: interaction: TBP>>=
	procedure :: find_source => interaction_find_source
	<<Interactions: sub interfaces>>=
	module subroutine interaction_find_source (int, i, int1, i1)
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(out), pointer :: int1
	integer, intent(out) :: i1
	end subroutine interaction_find_source
	<<Interactions: procedures>>=
	module subroutine interaction_find_source (int, i, int1, i1)
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(out), pointer :: int1
	integer, intent(out) :: i1
	type(external_link_t) :: link
	link = interaction_get_ultimate_source (int, i)
	int1 => external_link_get_ptr (link)
	i1 = external_link_get_index (link)
	end subroutine interaction_find_source

	@ %def interaction_find_source
	@ Follow source links recursively to return the ultimate source of a particle.
	<<Interactions: sub interfaces>>=
	module function interaction_get_ultimate_source (int, i) result (link)
	type(external_link_t) :: link
	type(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	end function interaction_get_ultimate_source
	<<Interactions: procedures>>=
	module function interaction_get_ultimate_source (int, i) result (link)
	type(external_link_t) :: link
	type(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	type(interaction_t), pointer :: int_src
	integer :: i_src
	link = int%source(i)
	if (external_link_is_set (link)) then
	do
	int_src => external_link_get_ptr (link)
	i_src = external_link_get_index (link)
	if (external_link_is_set (int_src%source(i_src))) then
	link = int_src%source(i_src)
	else
	exit
	end if
	end do
	end if
	end function interaction_get_ultimate_source

	@ %def interaction_get_ultimate_source
	@ Update mask entries by merging them with corresponding masks in
	interactions linked to the current one. The mask determines quantum
	numbers which are summed over.

	Note that both the mask of the current interaction and the mask of the
	linked interaction are updated (side effect!). This ensures that both
	agree for the linked particle.
	<<Interactions: interaction: TBP>>=
	procedure :: exchange_mask => interaction_exchange_mask
	<<Interactions: sub interfaces>>=
	module subroutine interaction_exchange_mask (int)
	class(interaction_t), intent(inout) :: int
	end subroutine interaction_exchange_mask
	<<Interactions: procedures>>=
	module subroutine interaction_exchange_mask (int)
	class(interaction_t), intent(inout) :: int
	integer :: i, index_link
	type(interaction_t), pointer :: int_link
	do i = 1, int%n_tot
	if (external_link_is_set (int%source(i))) then
	int_link => external_link_get_ptr (int%source(i))
	index_link = external_link_get_index (int%source(i))
	call interaction_merge_mask_entry &
	(int, i, int_link%mask(index_link))
	call interaction_merge_mask_entry &
	(int_link, index_link, int%mask(i))
	end if
	end do
	call int%freeze ()
	end subroutine interaction_exchange_mask

	@ %def interaction_exchange_mask
	@ Copy momenta from interactions linked to the current one.
	<<Interactions: interaction: TBP>>=
	procedure :: receive_momenta => interaction_receive_momenta
	<<Interactions: sub interfaces>>=
	module subroutine interaction_receive_momenta (int)
	class(interaction_t), intent(inout) :: int
	end subroutine interaction_receive_momenta
	<<Interactions: procedures>>=
	module subroutine interaction_receive_momenta (int)
	class(interaction_t), intent(inout) :: int
	integer :: i, index_link
	type(interaction_t), pointer :: int_link
	do i = 1, int%n_tot
	if (external_link_is_set (int%source(i))) then
	int_link => external_link_get_ptr (int%source(i))
	index_link = external_link_get_index (int%source(i))
	call int%set_momentum (int_link%p(index_link), i)
	end if
	end do
	end subroutine interaction_receive_momenta

	@ %def interaction_receive_momenta
	@ The inverse operation: Copy momenta back to the interactions linked
	to the current one.
	<<Interactions: interaction: TBP>>=
	procedure :: send_momenta => interaction_send_momenta
	<<Interactions: sub interfaces>>=
	module subroutine interaction_send_momenta (int)
	class(interaction_t), intent(in) :: int
	end subroutine interaction_send_momenta
	<<Interactions: procedures>>=
	module subroutine interaction_send_momenta (int)
	class(interaction_t), intent(in) :: int
	integer :: i, index_link
	type(interaction_t), pointer :: int_link
	do i = 1, int%n_tot
	if (external_link_is_set (int%source(i))) then
	int_link => external_link_get_ptr (int%source(i))
	index_link = external_link_get_index (int%source(i))
	call int_link%set_momentum (int%p(i), index_link)
	end if
	end do
	end subroutine interaction_send_momenta

	@ %def interaction_send_momenta
	@ For numerical comparisons: pacify all momenta in an interaction.
	<<Interactions: interaction: TBP>>=
	procedure :: pacify_momenta => interaction_pacify_momenta
	<<Interactions: sub interfaces>>=
	module subroutine interaction_pacify_momenta (int, acc)
	class(interaction_t), intent(inout) :: int
	real(default), intent(in) :: acc
	end subroutine interaction_pacify_momenta
	<<Interactions: procedures>>=
	module subroutine interaction_pacify_momenta (int, acc)
	class(interaction_t), intent(inout) :: int
	real(default), intent(in) :: acc
	integer :: i
	do i = 1, int%n_tot
	call pacify (int%p(i), acc)
	end do
	end subroutine interaction_pacify_momenta

	@ %def interaction_pacify_momenta
	@ For each subtraction entry starting from [[SUB = 0]], we duplicate
	the original state matrix entries as is.
	<<Interactions: interaction: TBP>>=
	procedure :: declare_subtraction => interaction_declare_subtraction
	<<Interactions: sub interfaces>>=
	module subroutine interaction_declare_subtraction (int, n_sub)
	class(interaction_t), intent(inout), target :: int
	integer, intent(in) :: n_sub
	end subroutine interaction_declare_subtraction
	<<Interactions: procedures>>=
	module subroutine interaction_declare_subtraction (int, n_sub)
	class(interaction_t), intent(inout), target :: int
	integer, intent(in) :: n_sub
	integer :: i_sub
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	type(state_matrix_t) :: state_matrix
	call state_matrix%init (store_values = .true.)
	allocate (qn (int%get_state_depth ()))
	do i_sub = 0, n_sub
	call it%init (int%state_matrix)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	call qn%set_subtraction_index (i_sub)
	call state_matrix%add_state (qn, value = it%get_matrix_element ())
	call it%advance ()
	end do
	end do
	call state_matrix%freeze ()
	call state_matrix%set_n_sub ()
	call int%state_matrix%final ()
	int%state_matrix = state_matrix
	end subroutine interaction_declare_subtraction

	@ %def interaction_declare_subtraction
	@
	\subsection{Recovering connections}
	When creating an evaluator for two interactions, we have to know by
	which particles they are connected. The connection indices can be
	determined if we have two linked interactions. We assume that
	[[int1]] is the source and [[int2]] the target, so the connections of
	interest are stored within [[int2]]. A connection is found if either the
	source is [[int1]], or the (ultimate)
	source of a particle within [[int2]] coincides with the (ultimate) source of a
	particle within [[int1]]. The result is an array of
	index pairs.

	To make things simple, we scan the interaction twice,
	once for counting hits, then allocate the array, then scan again and
	store the connections.

	The connections are scanned for [[int2]], which has sources in [[int1]]. It
	may happen that the order of connections is interchanged (crossed). We
	require the indices in [[int1]] to be sorted, so we reorder both index arrays
	correspondingly before returning them. (After this, the indices in [[int2]]
	may be out of order.)
	<<Interactions: public>>=
	public :: find_connections
	<<Interactions: sub interfaces>>=
	module subroutine find_connections (int1, int2, n, connection_index)
	class(interaction_t), intent(in) :: int1, int2
	integer, intent(out) :: n
	integer, dimension(:,:), intent(out), allocatable :: connection_index
	integer, dimension(:,:), allocatable :: conn_index_tmp
	integer, dimension(:), allocatable :: ordering
	end subroutine find_connections
	<<Interactions: procedures>>=
	module subroutine find_connections (int1, int2, n, connection_index)
	class(interaction_t), intent(in) :: int1, int2
	integer, intent(out) :: n
	integer, dimension(:,:), intent(out), allocatable :: connection_index
	integer, dimension(:,:), allocatable :: conn_index_tmp
	integer, dimension(:), allocatable :: ordering
	integer :: i, j, k
	type(external_link_t) :: link1, link2
	type(interaction_t), pointer :: int_link1, int_link2
	n = 0
	do i = 1, size (int2%source)
	link2 = interaction_get_ultimate_source (int2, i)
	if (external_link_is_set (link2)) then
	int_link2 => external_link_get_ptr (link2)
	if (int_link2%tag == int1%tag) then
	n = n + 1
	else
	k = external_link_get_index (link2)
	do j = 1, size (int1%source)
	link1 = interaction_get_ultimate_source (int1, j)
	if (external_link_is_set (link1)) then
	int_link1 => external_link_get_ptr (link1)
	if (int_link1%tag == int_link2%tag) then
	if (external_link_get_index (link1) == k) &
	n = n + 1
	end if
	end if
	end do
	end if
	end if
	end do
	allocate (conn_index_tmp (n, 2))
	n = 0
	do i = 1, size (int2%source)
	link2 = interaction_get_ultimate_source (int2, i)
	if (external_link_is_set (link2)) then
	int_link2 => external_link_get_ptr (link2)
	if (int_link2%tag == int1%tag) then
	n = n + 1
	conn_index_tmp(n,1) = external_link_get_index (int2%source(i))
	conn_index_tmp(n,2) = i
	else
	k = external_link_get_index (link2)
	do j = 1, size (int1%source)
	link1 = interaction_get_ultimate_source (int1, j)
	if (external_link_is_set (link1)) then
	int_link1 => external_link_get_ptr (link1)
	if (int_link1%tag == int_link2%tag) then
	if (external_link_get_index (link1) == k) then
	n = n + 1
	conn_index_tmp(n,1) = j
	conn_index_tmp(n,2) = i
	end if
	end if
	end if
	end do
	end if
	end if
	end do
	allocate (connection_index (n, 2))
	if (n > 1) then
	allocate (ordering (n))
	ordering = order (conn_index_tmp(:,1))
	connection_index = conn_index_tmp(ordering,:)
	else
	connection_index = conn_index_tmp
	end if
	end subroutine find_connections

	@ %def find_connections
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[interactions_ut.f90]]>>=
	<<File header>>

	module interactions_ut
	use unit_tests
	use interactions_uti

	<<Standard module head>>

	<<Interactions: public test>>

	contains

	<<Interactions: test driver>>

	end module interactions_ut
	@ %def interactions_ut
	@
	<<[[interactions_uti.f90]]>>=
	<<File header>>

	module interactions_uti

	<<Use kinds>>
	use lorentz
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices

	use interactions

	<<Standard module head>>

	<<Interactions: test declarations>>

	contains

	<<Interactions: tests>>

	end module interactions_uti
	@ %def interactions_ut
	@ API: driver for the unit tests below.
	<<Interactions: public test>>=
	public :: interaction_test
	<<Interactions: test driver>>=
	subroutine interaction_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Interactions: execute tests>>
	end subroutine interaction_test

	@ %def interaction_test
	@ Generate an interaction of a polarized virtual photon and a colored
	quark which may be either up or down. Remove the quark polarization.
	Generate another interaction for the quark radiating a photon and link
	this to the first interation. The radiation ignores polarization;
	transfer this information to the first interaction to simplify it.
	Then, transfer the momentum to the radiating quark and perform a
	splitting.
	<<Interactions: execute tests>>=
	call test (interaction_1, "interaction_1", &
	"check interaction setup", &
	u, results)
	<<Interactions: test declarations>>=
	public :: interaction_1
	<<Interactions: tests>>=
	subroutine interaction_1 (u)
	integer, intent(in) :: u
	type(interaction_t), target :: int, rad
	type(vector4_t), dimension(3) :: p
	type(quantum_numbers_mask_t), dimension(3) :: mask
	p(2) = vector4_moving (500._default, 500._default, 1)
	p(3) = vector4_moving (500._default,-500._default, 1)
	p(1) = p(2) + p(3)

	write (u, "(A)") "* Test output: interaction"
	write (u, "(A)") "* Purpose: check routines for interactions"
	write (u, "(A)")

	call int%basic_init (1, 0, 2, set_relations=.true., &
	store_values = .true. )
	call int_set (int, 1, -1, 1, 1, &
	cmplx (0.3_default, 0.1_default, kind=default))
	call int_set (int, 1, -1,-1, 1, &
	cmplx (0.5_default,-0.7_default, kind=default))
	call int_set (int, 1, 1, 1, 1, &
	cmplx (0.1_default, 0._default, kind=default))
	call int_set (int, -1, 1, -1, 2, &
	cmplx (0.4_default, -0.1_default, kind=default))
	call int_set (int, 1, 1, 1, 2, &
	cmplx (0.2_default, 0._default, kind=default))
	call int%freeze ()
	call int%set_momenta (p)
	mask = quantum_numbers_mask (.false.,.false., [.true.,.true.,.true.])
	call rad%basic_init (1, 0, 2, &
	mask=mask, set_relations=.true., store_values = .true.)
	call rad_set (1)
	call rad_set (2)
	call rad%set_source_link (1, int, 2)
	call rad%exchange_mask ()
	call rad%receive_momenta ()
	p(1) = rad%get_momentum (1)
	p(2) = 0.4_default * p(1)
	p(3) = p(1) - p(2)
	call rad%set_momenta (p(2:3), outgoing=.true.)
	call int%freeze ()
	call rad%freeze ()
	call rad%set_matrix_element &
	(cmplx (0._default, 0._default, kind=default))
	call int%basic_write (u)
	write (u, "(A)")
	call rad%basic_write (u)
	write (u, "(A)")
	write (u, "(A)") "* Cleanup"
	call int%final ()
	call rad%final ()
	write (u, "(A)")
	write (u, "(A)") "* Test interaction_1: successful."
	contains
	subroutine int_set (int, h1, h2, hq, q, val)
	type(interaction_t), target, intent(inout) :: int
	integer, intent(in) :: h1, h2, hq, q
	type(flavor_t), dimension(3) :: flv
	type(color_t), dimension(3) :: col
	type(helicity_t), dimension(3) :: hel
	type(quantum_numbers_t), dimension(3) :: qn
	complex(default), intent(in) :: val
	call flv%init ([21, q, -q])
	call col(2)%init_col_acl (5, 0)
	call col(3)%init_col_acl (0, 5)
	call hel%init ([h1, hq, -hq], [h2, hq, -hq])
	call qn%init (flv, col, hel)
	call int%add_state (qn)
	call int%set_matrix_element (val)
	end subroutine int_set
	subroutine rad_set (q)
	integer, intent(in) :: q
	type(flavor_t), dimension(3) :: flv
	type(quantum_numbers_t), dimension(3) :: qn
	call flv%init ([ q, q, 21 ])
	call qn%init (flv)
	call rad%add_state (qn)
	end subroutine rad_set
	end subroutine interaction_1

	@ %def interaction_1
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Matrix element evaluation}

	The [[evaluator_t]] type is an extension of the [[interaction_t]]
	type. It represents either a density matrix as the square of a
	transition matrix element, or the product of two density matrices.
	Usually, some quantum numbers are summed over in the result.

	The [[interaction_t]] subobject represents a multi-particle
	interaction with incoming, virtual, and outgoing particles and the
	associated (not necessarily diagonal) density matrix of quantum
	state. When the evaluator is initialized, this interaction is
	constructed from the input interaction(s).

	In addition, the initialization process sets up a multiplication
	table. For each matrix element of the result, it states which matrix
	elements are to be taken from the input interaction(s), multiplied
	(optionally, with an additional weight factor) and summed over.

	Eventually, to a processes we associate a chain of evaluators which
	are to be evaluated sequentially. The physical event and its matrix
	element value(s) can be extracted from the last evaluator in such a
	chain.

	Evaluators are constructed only once (as long as this is possible)
	during an initialization step. Then, for each event, momenta
	are computed and transferred among evaluators using the links within
	the interaction subobject. The multiplication tables enable fast
	evaluation of the result without looking at quantum numbers anymore.
	<<[[evaluators.f90]]>>=
	<<File header>>

	module evaluators

	<<Use kinds>>
	<<Use strings>>
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices
	use interactions

	<<Standard module head>>

	<<Evaluators: public>>

	<<Evaluators: parameters>>

	<<Evaluators: types>>

	<<Evaluators: interfaces>>

	interface
	<<Evaluators: sub interfaces>>
	end interface

	end module evaluators
	@ %def evaluators
	@
	<<[[evaluators_sub.f90]]>>=
	<<File header>>

	submodule (evaluators) evaluators_s

	use io_units
	use format_defs, only: FMT_19
	use physics_defs, only: n_beams_rescaled
	use diagnostics
	use lorentz

	implicit none

	contains

	<<Evaluators: procedures>>

	end submodule evaluators_s

	@ %def evaluators_s
	@
	\subsection{Array of pairings}
	The evaluator contains an array of [[pairing_array]] objects. This
	makes up the multiplication table.

	Each pairing array contains two lists of matrix element indices and a
	list of numerical factors. The matrix element indices correspond to
	the input interactions. The corresponding matrix elements are to be
	multiplied and optionally multiplied by a factor. The results are
	summed over to yield one specific matrix element of the result
	evaluator.
	<<Evaluators: types>>=
	type :: pairing_array_t
	integer, dimension(:), allocatable :: i1, i2
	complex(default), dimension(:), allocatable :: factor
	end type pairing_array_t

	@ %def pairing_array_t
	<<Evaluators: sub interfaces>>=
	elemental module subroutine pairing_array_init (pa, n, has_i2, has_factor)
	type(pairing_array_t), intent(out) :: pa
	integer, intent(in) :: n
	logical, intent(in) :: has_i2, has_factor
	end subroutine pairing_array_init
	<<Evaluators: procedures>>=
	elemental module subroutine pairing_array_init (pa, n, has_i2, has_factor)
	type(pairing_array_t), intent(out) :: pa
	integer, intent(in) :: n
	logical, intent(in) :: has_i2, has_factor
	allocate (pa%i1 (n))
	if (has_i2) allocate (pa%i2 (n))
	if (has_factor) allocate (pa%factor (n))
	end subroutine pairing_array_init

	@ %def pairing_array_init
	@
	<<Evaluators: public>>=
	public :: pairing_array_write
	<<Evaluators: sub interfaces>>=
	module subroutine pairing_array_write (pa, unit)
	type(pairing_array_t), intent(in) :: pa
	integer, intent(in), optional :: unit
	end subroutine pairing_array_write
	<<Evaluators: procedures>>=
	module subroutine pairing_array_write (pa, unit)
	type(pairing_array_t), intent(in) :: pa
	integer, intent(in), optional :: unit
	integer :: i, u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A)", advance = "no") "["
	if (allocated (pa%i1)) then
	write (u, "(I0,A)", advance = "no") pa%i1, ","
	else
	write (u, "(A)", advance = "no") "x,"
	end if
	if (allocated (pa%i2)) then
	write (u, "(I0,A)", advance = "no") pa%i1, ","
	else
	write (u, "(A)", advance = "no") "x,"
	end if
	write (u, "(A)", advance = "no") "]"
	if (allocated (pa%factor)) then
	write (u, "(A,F5.4,A,F5.4,A)") ";(", &
	real(pa%factor), ",", aimag(pa%factor), ")]"
	else
	write (u, "(A)") ""
	end if
	end subroutine pairing_array_write

	@ %def pairing_array_write
	@
	\subsection{The evaluator type}
	Possible variants of evaluators:
	<<Evaluators: parameters>>=
	integer, parameter :: &
	EVAL_UNDEFINED = 0, &
	EVAL_PRODUCT = 1, &
	EVAL_SQUARED_FLOWS = 2, &
	EVAL_SQUARE_WITH_COLOR_FACTORS = 3, &
	EVAL_COLOR_CONTRACTION = 4, &
	EVAL_IDENTITY = 5, &
	EVAL_QN_SUM = 6
	@ %def EVAL_PRODUCT EVAL_SQUARED_FLOWS EVAL_SQUARE_WITH_COLOR_FACTORS
	@ %def EVAL_COLOR_CONTRACTION EVAL_QN_SUM
	@ The evaluator type contains the result interaction and an array of
	pairing lists, one for each matrix element in the result interaction.
	<<Evaluators: public>>=
	public :: evaluator_t
	<<Evaluators: types>>=
	type, extends (interaction_t) :: evaluator_t
	private
	integer :: type = EVAL_UNDEFINED
	class(interaction_t), pointer :: int_in1 => null ()
	class(interaction_t), pointer :: int_in2 => null ()
	type(pairing_array_t), dimension(:), allocatable :: pairing_array
	contains
	<<Evaluators: evaluator: TBP>>
	end type evaluator_t

	@ %def evaluator_t
	@ Output.
	<<Evaluators: evaluator: TBP>>=
	procedure :: write => evaluator_write
	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_write (eval, unit, &
	verbose, show_momentum_sum, show_mass, show_state, show_table, &
	col_verbose, testflag)
	class(evaluator_t), intent(in) :: eval
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, show_momentum_sum, show_mass
	logical, intent(in), optional :: show_state, show_table, col_verbose
	logical, intent(in), optional :: testflag
	end subroutine evaluator_write
	<<Evaluators: procedures>>=
	module subroutine evaluator_write (eval, unit, &
	verbose, show_momentum_sum, show_mass, show_state, show_table, &
	col_verbose, testflag)
	class(evaluator_t), intent(in) :: eval
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, show_momentum_sum, show_mass
	logical, intent(in), optional :: show_state, show_table, col_verbose
	logical, intent(in), optional :: testflag
	logical :: conjugate, square, show_tab
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	show_tab = .true.; if (present (show_table)) show_tab = .false.
	call eval%basic_write &
	(unit, verbose, show_momentum_sum, show_mass, &
	show_state, col_verbose, testflag)
	if (show_tab) then
	write (u, "(1x,A)") "Matrix-element multiplication"
	write (u, "(2x,A)", advance="no") "Input interaction 1:"
	if (associated (eval%int_in1)) then
	write (u, "(1x,I0)") eval%int_in1%get_tag ()
	else
	write (u, "(A)") " [undefined]"
	end if
	write (u, "(2x,A)", advance="no") "Input interaction 2:"
	if (associated (eval%int_in2)) then
	write (u, "(1x,I0)") eval%int_in2%get_tag ()
	else
	write (u, "(A)") " [undefined]"
	end if
	select case (eval%type)
	case (EVAL_SQUARED_FLOWS, EVAL_SQUARE_WITH_COLOR_FACTORS)
	conjugate = .true.
	square = .true.
	case (EVAL_IDENTITY)
	write (u, "(1X,A)") "Identity evaluator, pairing array unused"
	return
	case default
	conjugate = .false.
	square = .false.
	end select
	call eval%write_pairing_array (conjugate, square, u)
	end if
	end subroutine evaluator_write

	@ %def evaluator_write
	@
	<<Evaluators: evaluator: TBP>>=
	procedure :: write_pairing_array => evaluator_write_pairing_array
	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_write_pairing_array (eval, conjugate, square, unit)
	class(evaluator_t), intent(in) :: eval
	logical, intent(in) :: conjugate, square
	integer, intent(in), optional :: unit
	end subroutine evaluator_write_pairing_array
	<<Evaluators: procedures>>=
	module subroutine evaluator_write_pairing_array (eval, conjugate, square, unit)
	class(evaluator_t), intent(in) :: eval
	logical, intent(in) :: conjugate, square
	integer, intent(in), optional :: unit
	integer :: u, i, j
	u = given_output_unit (unit); if (u < 0) return
	if (allocated (eval%pairing_array)) then
	do i = 1, size (eval%pairing_array)
	write (u, "(2x,A,I0,A)") "ME(", i, ") = "
	do j = 1, size (eval%pairing_array(i)%i1)
	write (u, "(4x,A)", advance="no") "+"
	if (allocated (eval%pairing_array(i)%i2)) then
	write (u, "(1x,A,I0,A)", advance="no") &
	"ME1(", eval%pairing_array(i)%i1(j), ")"
	if (conjugate) then
	write (u, "(A)", advance="no") "* x"
	else
	write (u, "(A)", advance="no") " x"
	end if
	write (u, "(1x,A,I0,A)", advance="no") &
	"ME2(", eval%pairing_array(i)%i2(j), ")"
	else if (square) then
	write (u, "(1x,A)", advance="no") "\|"
	write (u, "(A,I0,A)", advance="no") &
	"ME1(", eval%pairing_array(i)%i1(j), ")"
	write (u, "(A)", advance="no") "\|^2"
	else
	write (u, "(1x,A,I0,A)", advance="no") &
	"ME1(", eval%pairing_array(i)%i1(j), ")"
	end if
	if (allocated (eval%pairing_array(i)%factor)) then
	write (u, "(1x,A)", advance="no") "x"
	write (u, "(1x,'('," // FMT_19 // ",','," // FMT_19 // &
	",')')") eval%pairing_array(i)%factor(j)
	else
	write (u, *)
	end if
	end do
	end do
	end if
	end subroutine evaluator_write_pairing_array

	@ %def evaluator_write_pairing_array
	@ Assignment: Deep copy of the interaction component.
	<<Evaluators: public>>=
	public :: assignment(=)
	<<Evaluators: interfaces>>=
	interface assignment(=)
	module procedure evaluator_assign
	end interface

	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_assign (eval_out, eval_in)
	type(evaluator_t), intent(out) :: eval_out
	type(evaluator_t), intent(in) :: eval_in
	end subroutine evaluator_assign
	<<Evaluators: procedures>>=
	module subroutine evaluator_assign (eval_out, eval_in)
	type(evaluator_t), intent(out) :: eval_out
	type(evaluator_t), intent(in) :: eval_in
	eval_out%type = eval_in%type
	eval_out%int_in1 => eval_in%int_in1
	eval_out%int_in2 => eval_in%int_in2
	eval_out%interaction_t = eval_in%interaction_t
	if (allocated (eval_in%pairing_array)) then
	allocate (eval_out%pairing_array (size (eval_in%pairing_array)))
	eval_out%pairing_array = eval_in%pairing_array
	end if
	end subroutine evaluator_assign

	@ %def evaluator_assign
	@
	\subsection{Auxiliary structures for evaluator creation}
	Creating an evaluator that properly handles all quantum numbers requires some
	bookkeeping. In this section, we define several auxiliary types and methods
	that organize and simplify this task. More structures are defined within the
	specific initializers (as local types and internal subroutines).

	These types are currently implemented in a partial object-oriented way: We
	define some basic methods for initialization etc.\ here, but the evaluator
	routines below do access their internals as well. This simplifies some things
	such as index addressing using array slices, at the expense of losing some
	clarity.

	\subsubsection{Index mapping}
	Index mapping are abundant when constructing an evaluator. To have arrays of
	index mappings, we define this:
	<<Evaluators: types>>=
	type :: index_map_t
	integer, dimension(:), allocatable :: entry
	end type index_map_t

	@ %def index_map_t
	<<Evaluators: sub interfaces>>=
	elemental module subroutine index_map_init (map, n)
	type(index_map_t), intent(out) :: map
	integer, intent(in) :: n
	end subroutine index_map_init
	<<Evaluators: procedures>>=
	elemental module subroutine index_map_init (map, n)
	type(index_map_t), intent(out) :: map
	integer, intent(in) :: n
	allocate (map%entry (n))
	map%entry = 0
	end subroutine index_map_init

	@ %def index_map_init
	<<Evaluators: procedures>>=
	function index_map_exists (map) result (flag)
	logical :: flag
	type(index_map_t), intent(in) :: map
	flag = allocated (map%entry)
	end function index_map_exists

	@ %def index_map_exists
	<<Evaluators: interfaces>>=
	interface size
	module procedure index_map_size
	end interface

	@ %def size
	<<Evaluators: sub interfaces>>=
	module function index_map_size (map) result (s)
	integer :: s
	type(index_map_t), intent(in) :: map
	end function index_map_size
	<<Evaluators: procedures>>=
	module function index_map_size (map) result (s)
	integer :: s
	type(index_map_t), intent(in) :: map
	if (allocated (map%entry)) then
	s = size (map%entry)
	else
	s = 0
	end if
	end function index_map_size

	@ %def index_map_size
	<<Evaluators: interfaces>>=
	interface assignment(=)
	module procedure index_map_assign_int
	module procedure index_map_assign_array
	end interface

	@ %def =
	<<Evaluators: sub interfaces>>=
	elemental module subroutine index_map_assign_int (map, ival)
	type(index_map_t), intent(inout) :: map
	integer, intent(in) :: ival
	end subroutine index_map_assign_int
	module subroutine index_map_assign_array (map, array)
	type(index_map_t), intent(inout) :: map
	integer, dimension(:), intent(in) :: array
	end subroutine index_map_assign_array
	<<Evaluators: procedures>>=
	elemental module subroutine index_map_assign_int (map, ival)
	type(index_map_t), intent(inout) :: map
	integer, intent(in) :: ival
	map%entry = ival
	end subroutine index_map_assign_int

	module subroutine index_map_assign_array (map, array)
	type(index_map_t), intent(inout) :: map
	integer, dimension(:), intent(in) :: array
	map%entry = array
	end subroutine index_map_assign_array

	@ %def index_map_assign_int index_map_assign_array
	<<Evaluators: sub interfaces>>=
	elemental module subroutine index_map_set_entry (map, i, ival)
	type(index_map_t), intent(inout) :: map
	integer, intent(in) :: i
	integer, intent(in) :: ival
	end subroutine index_map_set_entry
	<<Evaluators: procedures>>=
	elemental module subroutine index_map_set_entry (map, i, ival)
	type(index_map_t), intent(inout) :: map
	integer, intent(in) :: i
	integer, intent(in) :: ival
	map%entry(i) = ival
	end subroutine index_map_set_entry

	@ %def index_map_set_entry
	<<Evaluators: sub interfaces>>=
	elemental module function index_map_get_entry (map, i) result (ival)
	integer :: ival
	type(index_map_t), intent(in) :: map
	integer, intent(in) :: i
	end function index_map_get_entry
	<<Evaluators: procedures>>=
	elemental module function index_map_get_entry (map, i) result (ival)
	integer :: ival
	type(index_map_t), intent(in) :: map
	integer, intent(in) :: i
	ival = map%entry(i)
	end function index_map_get_entry

	@ %def index_map_get_entry
	@
	\subsubsection{Index mapping (two-dimensional)}
	This is a variant with a square matrix instead of an array.
	<<Evaluators: types>>=
	type :: index_map2_t
	integer :: s = 0
	integer, dimension(:,:), allocatable :: entry
	end type index_map2_t

	@ %def index_map2_t
	<<Evaluators: procedures>>=
	elemental subroutine index_map2_init (map, n)
	type(index_map2_t), intent(out) :: map
	integer, intent(in) :: n
	map%s = n
	allocate (map%entry (n, n))
	end subroutine index_map2_init

	@ %def index_map2_init
	<<Evaluators: procedures>>=
	function index_map2_exists (map) result (flag)
	logical :: flag
	type(index_map2_t), intent(in) :: map
	flag = allocated (map%entry)
	end function index_map2_exists

	@ %def index_map2_exists
	<<Evaluators: interfaces>>=
	interface size
	module procedure index_map2_size
	end interface

	@ %def size
	<<Evaluators: sub interfaces>>=
	module function index_map2_size (map) result (s)
	integer :: s
	type(index_map2_t), intent(in) :: map
	end function index_map2_size
	<<Evaluators: procedures>>=
	module function index_map2_size (map) result (s)
	integer :: s
	type(index_map2_t), intent(in) :: map
	s = map%s
	end function index_map2_size

	@ %def index_map2_size
	<<Evaluators: interfaces>>=
	interface assignment(=)
	module procedure index_map2_assign_int
	end interface

	@ %def =
	<<Evaluators: sub interfaces>>=
	elemental module subroutine index_map2_assign_int (map, ival)
	type(index_map2_t), intent(inout) :: map
	integer, intent(in) :: ival
	end subroutine index_map2_assign_int
	<<Evaluators: procedures>>=
	elemental module subroutine index_map2_assign_int (map, ival)
	type(index_map2_t), intent(inout) :: map
	integer, intent(in) :: ival
	map%entry = ival
	end subroutine index_map2_assign_int

	@ %def index_map2_assign_int
	<<Evaluators: procedures>>=
	elemental subroutine index_map2_set_entry (map, i, j, ival)
	type(index_map2_t), intent(inout) :: map
	integer, intent(in) :: i, j
	integer, intent(in) :: ival
	map%entry(i,j) = ival
	end subroutine index_map2_set_entry

	@ %def index_map2_set_entry
	<<Evaluators: procedures>>=
	elemental function index_map2_get_entry (map, i, j) result (ival)
	integer :: ival
	type(index_map2_t), intent(in) :: map
	integer, intent(in) :: i, j
	ival = map%entry(i,j)
	end function index_map2_get_entry

	@ %def index_map2_get_entry
	@
	\subsubsection{Auxiliary structures: particle mask}
	This is a simple container of a logical array.
	<<Evaluators: types>>=
	type :: prt_mask_t
	logical, dimension(:), allocatable :: entry
	end type prt_mask_t

	@ %def prt_mask_t
	<<Evaluators: procedures>>=
	subroutine prt_mask_init (mask, n)
	type(prt_mask_t), intent(out) :: mask
	integer, intent(in) :: n
	allocate (mask%entry (n))
	end subroutine prt_mask_init

	@ %def prt_mask_init
	<<Evaluators: interfaces>>=
	interface size
	module procedure prt_mask_size
	end interface

	@ %def size
	<<Evaluators: sub interfaces>>=
	module function prt_mask_size (mask) result (s)
	integer :: s
	type(prt_mask_t), intent(in) :: mask
	end function prt_mask_size
	<<Evaluators: procedures>>=
	module function prt_mask_size (mask) result (s)
	integer :: s
	type(prt_mask_t), intent(in) :: mask
	s = size (mask%entry)
	end function prt_mask_size

	@ %def prt_mask_size
	@
	\subsubsection{Quantum number containers}
	Trivial transparent containers:
	<<Evaluators: types>>=
	type :: qn_list_t
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	end type qn_list_t

	type :: qn_mask_array_t
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
	end type qn_mask_array_t

	@ %def qn_list_t qn_mask_array_t
	@
	\subsubsection{Auxiliary structures: connection entries}
	This type is used as intermediate storage when computing the product of two
	evaluators or the square of an evaluator. The quantum-number array [[qn]]
	corresponds to the particles common to both interactions, but irrelevant
	quantum numbers (color) masked out. The index arrays [[index_in]] determine
	the entries in the input interactions that contribute to this connection.
	[[n_index]] is the size of these arrays, and [[count]] is used while filling
	the entries. Finally, the quantum-number arrays [[qn_in_list]] are the actual
	entries in the input interaction that contribute. In the product case, they
	exclude the connected quantum numbers.

	Each evaluator has its own [[connection_table]] which contains an array of
	[[connection_entry]] objects, but also has stuff that specifically applies to
	the evaluator type. Hence, we do not generalize the [[connection_table_t]]
	type.

	The filling procedure [[connection_entry_add_state]] is specific to the
	various evaluator types.
	<<Evaluators: types>>=
	type :: connection_entry_t
	type(quantum_numbers_t), dimension(:), allocatable :: qn_conn
	integer, dimension(:), allocatable :: n_index
	integer, dimension(:), allocatable :: count
	type(index_map_t), dimension(:), allocatable :: index_in
	type(qn_list_t), dimension(:), allocatable :: qn_in_list
	end type connection_entry_t

	@ %def connection_entry_t
	<<Evaluators: procedures>>=
	subroutine connection_entry_init &
	(entry, n_count, n_map, qn_conn, count, n_rest)
	type(connection_entry_t), intent(out) :: entry
	integer, intent(in) :: n_count, n_map
	type(quantum_numbers_t), dimension(:), intent(in) :: qn_conn
	integer, dimension(n_count), intent(in) :: count
	integer, dimension(n_count), intent(in) :: n_rest
	integer :: i
	allocate (entry%qn_conn (size (qn_conn)))
	allocate (entry%n_index (n_count))
	allocate (entry%count (n_count))
	allocate (entry%index_in (n_map))
	allocate (entry%qn_in_list (n_count))
	entry%qn_conn = qn_conn
	entry%n_index = count
	entry%count = 0
	if (size (entry%index_in) == size (count)) then
	call index_map_init (entry%index_in, count)
	else
	call index_map_init (entry%index_in, count(1))
	end if
	do i = 1, n_count
	allocate (entry%qn_in_list(i)%qn (n_rest(i), count(i)))
	end do
	end subroutine connection_entry_init

	@ %def connection_entry_init
	<<Evaluators: procedures>>=
	subroutine connection_entry_write (entry, unit)
	type(connection_entry_t), intent(in) :: entry
	integer, intent(in), optional :: unit
	integer :: i, j
	integer :: u
	u = given_output_unit (unit)
	call quantum_numbers_write (entry%qn_conn, unit)
	write (u, *)
	do i = 1, size (entry%n_index)
	write (u, *) "Input interaction", i
	do j = 1, entry%n_index(i)
	if (size (entry%n_index) == size (entry%index_in)) then
	write (u, "(2x,I0,4x,I0,2x)", advance = "no") &
	j, index_map_get_entry (entry%index_in(i), j)
	else
	write (u, "(2x,I0,4x,I0,2x,I0,2x)", advance = "no") &
	j, index_map_get_entry (entry%index_in(1), j), &
	index_map_get_entry (entry%index_in(2), j)
	end if
	call quantum_numbers_write (entry%qn_in_list(i)%qn(:,j), unit)
	write (u, *)
	end do
	end do
	end subroutine connection_entry_write

	@ %def connection_entry_write
	@ These are the different connection tables for the three different
	cases of evaluators for matrix elements, squared diagonal and
	non-diagonal matrix elements, respectively.
	<<Evaluators: types>>=
	type :: connection_table_t
	integer :: n_conn = 0
	integer, dimension(2) :: n_rest = 0
	integer :: n_tot = 0
	integer :: n_me_conn = 0
	type(state_matrix_t) :: state
	type(index_map_t), dimension(:), allocatable :: index_conn
	type(connection_entry_t), dimension(:), allocatable :: entry
	type(index_map_t) :: index_result
	end type connection_table_t

	type :: connection_table_diag_t
	integer :: n_tot = 0
	integer :: n_me_conn = 0
	type(state_matrix_t) :: state
	type(index_map_t) :: index_conn
	type(connection_entry_t), dimension(:), allocatable :: entry
	type(index_map_t) :: index_result
	end type connection_table_diag_t

	type :: connection_table_nondiag_t
	integer :: n_tot = 0
	integer :: n_me_conn = 0
	type(state_matrix_t) :: state
	type(index_map2_t) :: index_conn
	type(connection_entry_t), dimension(:), allocatable :: entry
	type(index_map_t) :: index_result
	end type connection_table_nondiag_t

	@ %def connection_table_t
	@ %def connection_table_diag_t
	@
	\subsubsection{Color handling}
	For managing color-factor computation, we introduce this local type. The
	[[index]] is the index in the color table that corresponds to a given matrix
	element index in the input interaction. The [[col]] array stores the color
	assignments in rows. The [[factor]] array associates a complex number with
	each pair of arrays in the color table. The [[factor_is_known]] array reveals
	whether a given factor is known already or still has to be computed.
	<<Evaluators: types>>=
	type :: color_table_t
	integer, dimension(:), allocatable :: index
	type(color_t), dimension(:,:), allocatable :: col
	logical, dimension(:,:), allocatable :: factor_is_known
	complex(default), dimension(:,:), allocatable :: factor
	end type color_table_t

	@ %def color_table_t
	@ This is the initializer. We extract the color states from the given state
	matrices, establish index mappings between the two states (implemented by the
	array [[me_index]]), make an array of color states, and initialize the
	color-factor table. The latter is two-dimensional (includes interference) and
	not yet filled.
	<<Evaluators: procedures>>=
	subroutine color_table_init (color_table, state, n_tot)
	type(color_table_t), intent(out) :: color_table
	type(state_matrix_t), intent(in) :: state
	integer, intent(in) :: n_tot
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	type(state_matrix_t) :: state_col
	integer :: index, n_col_state
	allocate (color_table%index (state%get_n_matrix_elements ()))
	color_table%index = 0
	allocate (qn (n_tot))
	call state_col%init ()
	call it%init (state)
	do while (it%is_valid ())
	index = it%get_me_index ()
	call qn%init (col = it%get_color ())
	call state_col%add_state (qn, me_index = color_table%index(index))
	call it%advance ()
	end do
	n_col_state = state_col%get_n_matrix_elements ()
	allocate (color_table%col (n_tot, n_col_state))
	call it%init (state_col)
	do while (it%is_valid ())
	index = it%get_me_index ()
	color_table%col(:,index) = it%get_color ()
	call it%advance ()
	end do
	call state_col%final ()
	allocate (color_table%factor_is_known (n_col_state, n_col_state))
	allocate (color_table%factor (n_col_state, n_col_state))
	color_table%factor_is_known = .false.
	end subroutine color_table_init

	@ %def color_table_init
	@ Output (debugging use):
	<<Evaluators: procedures>>=
	subroutine color_table_write (color_table, unit)
	type(color_table_t), intent(in) :: color_table
	integer, intent(in), optional :: unit
	integer :: i, j
	integer :: u
	u = given_output_unit (unit)
	write (u, *) "Color table:"
	if (allocated (color_table%index)) then
	write (u, *) " Index mapping state => color table:"
	do i = 1, size (color_table%index)
	write (u, "(3x,I0,2x,I0,2x)") i, color_table%index(i)
	end do
	write (u, *) " Color table:"
	do i = 1, size (color_table%col, 2)
	write (u, "(3x,I0,2x)", advance = "no") i
	call color_write (color_table%col(:,i), unit)
	write (u, *)
	end do
	write (u, *) " Defined color factors:"
	do i = 1, size (color_table%factor, 1)
	do j = 1, size (color_table%factor, 2)
	if (color_table%factor_is_known(i,j)) then
	write (u, *) i, j, color_table%factor(i,j)
	end if
	end do
	end do
	end if
	end subroutine color_table_write

	@ %def color_table_write
	@ This subroutine sets color factors, based on information from the hard
	matrix element: the list of pairs of color-flow indices (in the basis of the
	matrix element code), the list of corresponding factors, and the list of
	mappings from the matrix element index in the input interaction to the
	color-flow index in the hard matrix element object.

	We first determine the mapping of color-flow indices from the hard matrix
	element code to the current color table. The mapping could be nontrivial
	because the latter is derived from iterating over a state matrix, which may
	return states in non-canonical order. The translation table can be determined
	because we have, for the complete state matrix, both the mapping to the hard
	interaction (the input [[col_index_hi]]) and the mapping to the current
	color table (the component [[color_table%index]]).

	Once this mapping is known, we scan the list of index pairs
	[[color_flow_index]] and translate them to valid color-table index pairs. For
	this pair, the color factor is set using the corresponding entry in the list
	[[col_factor]].
	<<Evaluators: procedures>>=
	subroutine color_table_set_color_factors (color_table, &
	col_flow_index, col_factor, col_index_hi)
	type(color_table_t), intent(inout) :: color_table
	integer, dimension(:,:), intent(in) :: col_flow_index
	complex(default), dimension(:), intent(in) :: col_factor
	integer, dimension(:), intent(in) :: col_index_hi
	integer, dimension(:), allocatable :: hi_to_ct
	integer :: n_cflow
	integer :: hi_index, me_index, ct_index, cf_index
	integer, dimension(2) :: hi_index_pair, ct_index_pair
	n_cflow = size (col_index_hi)
	if (size (color_table%index) /= n_cflow) &
	call msg_bug ("Mismatch between hard matrix element and color table")
	allocate (hi_to_ct (n_cflow))
	do me_index = 1, size (color_table%index)
	ct_index = color_table%index(me_index)
	hi_index = col_index_hi(me_index)
	hi_to_ct(hi_index) = ct_index
	end do
	do cf_index = 1, size (col_flow_index, 2)
	hi_index_pair = col_flow_index(:,cf_index)
	ct_index_pair = hi_to_ct(hi_index_pair)
	color_table%factor(ct_index_pair(1), ct_index_pair(2)) = &
	col_factor(cf_index)
	color_table%factor_is_known(ct_index_pair(1), ct_index_pair(2)) = .true.
	end do
	end subroutine color_table_set_color_factors

	@ %def color_table_set_color_factors
	@ This function returns a color factor, given two indices which point to the
	matrix elements of the initial state matrix. Internally, we can map them to
	the corresponding indices in the color table. As a side effect, we store the
	color factor in the color table for later lookup. (I.e., this function is
	impure.)
	<<Evaluators: procedures>>=
	function color_table_get_color_factor (color_table, index1, index2, nc) &
	result (factor)
	real(default) :: factor
	type(color_table_t), intent(inout) :: color_table
	integer, intent(in) :: index1, index2
	integer, intent(in), optional :: nc
	integer :: i1, i2
	i1 = color_table%index(index1)
	i2 = color_table%index(index2)
	if (color_table%factor_is_known(i1,i2)) then
	factor = real(color_table%factor(i1,i2), kind=default)
	else
	factor = compute_color_factor &
	(color_table%col(:,i1), color_table%col(:,i2), nc)
	color_table%factor(i1,i2) = factor
	color_table%factor_is_known(i1,i2) = .true.
	end if
	end function color_table_get_color_factor

	@ %def color_table_get_color_factor
	@
	\subsection{Creating an evaluator: Matrix multiplication}
	The evaluator for matrix multiplication is the most complicated
	variant.

	The initializer takes two input interactions and constructs the result
	evaluator, which consists of the interaction and the multiplication
	table for the product (or convolution) of the two. Normally, the
	input interactions are connected by one or more common particles
	(e.g., decay, structure function convolution).

	In the result interaction, quantum numbers of the connections can be
	summed over. This is determined by the [[qn_mask_conn]] argument.
	The [[qn_mask_rest]] argument is its analog for the other particles
	within the result interaction. (E.g., for the trace of the state
	matrix, all quantum numbers are summed over.)

	Finally, the
	[[connections_are_resonant]] argument tells whether the connecting
	particles should be marked as resonant in the final event record. If true,
	this also implies that the second interaction is not the hard process, so any
	corresponding tags should be removed from the outgoing particles.
	This applies to decays.

	The algorithm consists of the following steps:
	\begin{enumerate}
	\item
	[[find_connections]]: Find the particles which are connected, i.e.,
	common to both input interactions. Either they are directly linked,
	or both are linked to a common source.
	\item
	[[compute_index_bounds_and_mappings]]: Compute the mappings of
	particle indices from the input interactions to the result
	interaction. There is a separate mapping for the connected
	particles.
	\item
	[[accumulate_connected_states]]: Create an auxiliary state matrix
	which lists the possible quantum numbers for the connected
	particles. When building this matrix, count the number of times
	each assignment is contained in any of the input states and, for
	each of the input states, record the index of the matrix element
	within the new state matrix. For the connected particles, reassign
	color indices such that no color state is present twice in different
	color-index assignment. Note that helicity assignments of the
	connected state can be (and will be) off-diagonal, so no spin
	correlations are lost in decays.

	Do this for both input interactions.
	\item
	[[allocate_connection_entries]]: Allocate a table of connections.
	Each table row corresponds to one state in the auxiliary matrix, and
	to multiple states of the input interactions. It collects all
	states of the unconnected particles in the two input interactions
	that are associated with the particular state (quantum-number
	assignment) of the connected particles.
	\item
	[[fill_connection_table]]: Fill the table of connections by scanning
	both input interactions. When copying states, reassign color
	indices for the unconnected particles such that they match between
	all involved particle sets (interaction 1, interaction 2, and
	connected particles).
	\item
	[[make_product_interaction]]: Scan the table of connections we have
	just built. For each entry, construct all possible pairs of states
	of the unconnected particles and combine them with the specific
	connected-particle state. This is a possible quantum-number
	assignment of the result interaction. Now mask all quantum numbers
	that should be summed over, and append this to the result state
	matrix. Record the matrix element index of the result. We now have
	the result interaction.
	\item
	[[make_pairing_array]]: First allocate the pairing array with the
	number of entries of the result interaction. Then scan the table of
	connections again. For each entry, record the indices of the matrix
	elements which have to be multiplied and summed over in order to
	compute this particular matrix element. This makes up the
	multiplication table.
	\item
	[[record_links]]: Transfer all source pointers from the input
	interactions to the result interaction. Do the same for the
	internal parent-child relations and resonance assignments. For the
	connected particles, make up appropriate additional parent-child
	relations. This allows for fetching momenta from other interactions
	when a new event is filled, and to reconstruct the event history
	when the event is analyzed.
	\end{enumerate}

	After all this is done, for each event, we just have to evaluate the
	pairing arrays (multiplication tables) in order to compute the result
	matrix elements in their proper positions. The quantum-number
	assignments remain fixed from now on.
	<<Evaluators: evaluator: TBP>>=
	procedure :: init_product => evaluator_init_product
	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_init_product &
	(eval, int_in1, int_in2, qn_mask_conn, qn_filter_conn, qn_mask_rest, &
	connections_are_resonant, ignore_sub_for_qn)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in1, int_in2
	type(quantum_numbers_mask_t), intent(in) :: qn_mask_conn
	type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
	type(quantum_numbers_mask_t), intent(in), optional :: qn_mask_rest
	logical, intent(in), optional :: connections_are_resonant
	logical, intent(in), optional :: ignore_sub_for_qn
	end subroutine evaluator_init_product
	<<Evaluators: procedures>>=
	module subroutine evaluator_init_product &
	(eval, int_in1, int_in2, qn_mask_conn, qn_filter_conn, qn_mask_rest, &
	connections_are_resonant, ignore_sub_for_qn)

	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in1, int_in2
	type(quantum_numbers_mask_t), intent(in) :: qn_mask_conn
	type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
	type(quantum_numbers_mask_t), intent(in), optional :: qn_mask_rest
	logical, intent(in), optional :: connections_are_resonant
	logical, intent(in), optional :: ignore_sub_for_qn

	type(qn_mask_array_t), dimension(2) :: qn_mask_in
	type(state_matrix_t), pointer :: state_in1, state_in2
	type(connection_table_t) :: connection_table

	integer :: n_in, n_vir, n_out, n_tot
	integer, dimension(2) :: n_rest
	integer :: n_conn

	integer, dimension(:,:), allocatable :: connection_index
	type(index_map_t), dimension(2) :: prt_map_in
	type(index_map_t) :: prt_map_conn
	type(prt_mask_t), dimension(2) :: prt_is_connected
	type(quantum_numbers_mask_t), dimension(:), allocatable :: &
	qn_mask_conn_initial, int_in1_mask, int_in2_mask

	integer :: i

	eval%type = EVAL_PRODUCT
	eval%int_in1 => int_in1
	eval%int_in2 => int_in2

	state_in1 => int_in1%get_state_matrix_ptr ()
	state_in2 => int_in2%get_state_matrix_ptr ()

	call find_connections (int_in1, int_in2, n_conn, connection_index)
	if (n_conn == 0) then
	call msg_message ("First interaction:")
	call int_in1%basic_write (col_verbose=.true.)
	call msg_message ("Second interaction:")
	call int_in2%basic_write (col_verbose=.true.)
	call msg_fatal ("Evaluator product: no connections found between factors")
	end if
	call compute_index_bounds_and_mappings &
	(int_in1, int_in2, n_conn, &
	n_in, n_vir, n_out, n_tot, &
	n_rest, prt_map_in, prt_map_conn)

	call prt_mask_init (prt_is_connected(1), int_in1%get_n_tot ())
	call prt_mask_init (prt_is_connected(2), int_in2%get_n_tot ())
	do i = 1, 2
	prt_is_connected(i)%entry = .true.
	prt_is_connected(i)%entry(connection_index(:,i)) = .false.
	end do
	allocate (qn_mask_conn_initial (n_conn), &
	int_in1_mask (n_conn), int_in2_mask (n_conn))
	int_in1_mask = int_in1%get_mask (connection_index(:,1))
	int_in2_mask = int_in2%get_mask (connection_index(:,2))
	do i = 1, n_conn
	qn_mask_conn_initial(i) = int_in1_mask(i) .or. int_in2_mask(i)
	end do
	allocate (qn_mask_in(1)%mask (int_in1%get_n_tot ()))
	allocate (qn_mask_in(2)%mask (int_in2%get_n_tot ()))
	qn_mask_in(1)%mask = int_in1%get_mask ()
	qn_mask_in(2)%mask = int_in2%get_mask ()
	call connection_table_init (connection_table, &
	state_in1, state_in2, &
	qn_mask_conn_initial, &
	n_conn, connection_index, n_rest, &
	qn_filter_conn, ignore_sub_for_qn)
	call connection_table_fill (connection_table, &
	state_in1, state_in2, &
	connection_index, prt_is_connected)
	call make_product_interaction (eval%interaction_t, &
	n_in, n_vir, n_out, &
	connection_table, &
	prt_map_in, prt_is_connected, &
	qn_mask_in, qn_mask_conn_initial, &
	qn_mask_conn, qn_filter_conn, qn_mask_rest)
	call make_pairing_array (eval%pairing_array, &
	eval%get_n_matrix_elements (), &
	connection_table)
	call record_links (eval%interaction_t, &
	int_in1, int_in2, connection_index, prt_map_in, prt_map_conn, &
	prt_is_connected, connections_are_resonant)
	call connection_table_final (connection_table)

	if (eval%get_n_matrix_elements () == 0) then
	print *, "Evaluator product"
	print *, "First interaction"
	call int_in1%basic_write (col_verbose=.true.)
	print *
	print *, "Second interaction"
	call int_in2%basic_write (col_verbose=.true.)
	print *
	call msg_fatal ("Product of density matrices is empty", &
	[var_str (" --------------------------------------------"), &
	var_str ("This happens when two density matrices are convoluted "), &
	var_str ("but the processes they belong to (e.g., production "), &
	var_str ("and decay) do not match. This could happen if the "), &
	var_str ("beam specification does not match the hard "), &
	var_str ("process. Or it may indicate a WHIZARD bug.")])
	end if

	contains

	subroutine compute_index_bounds_and_mappings &
	(int1, int2, n_conn, &
	n_in, n_vir, n_out, n_tot, &
	n_rest, prt_map_in, prt_map_conn)
	class(interaction_t), intent(in) :: int1, int2
	integer, intent(in) :: n_conn
	integer, intent(out) :: n_in, n_vir, n_out, n_tot
	integer, dimension(2), intent(out) :: n_rest
	type(index_map_t), dimension(2), intent(out) :: prt_map_in
	type(index_map_t), intent(out) :: prt_map_conn
	integer, dimension(:), allocatable :: index
	integer :: n_in1, n_vir1, n_out1
	integer :: n_in2, n_vir2, n_out2
	integer :: k
	n_in1 = int1%get_n_in ()
	n_vir1 = int1%get_n_vir ()
	n_out1 = int1%get_n_out () - n_conn
	n_rest(1) = n_in1 + n_vir1 + n_out1
	n_in2 = int2%get_n_in () - n_conn
	n_vir2 = int2%get_n_vir ()
	n_out2 = int2%get_n_out ()
	n_rest(2) = n_in2 + n_vir2 + n_out2
	n_in = n_in1 + n_in2
	n_vir = n_vir1 + n_vir2 + n_conn
	n_out = n_out1 + n_out2
	n_tot = n_in + n_vir + n_out
	call index_map_init (prt_map_in, n_rest)
	call index_map_init (prt_map_conn, n_conn)
	allocate (index (n_tot))
	index = [ (i, i = 1, n_tot) ]
	prt_map_in(1)%entry(1 : n_in1) = index( 1 : n_in1)
	k = n_in1
	prt_map_in(2)%entry(1 : n_in2) = index(k + 1 : k + n_in2)
	k = k + n_in2
	prt_map_in(1)%entry(n_in1 + 1 : n_in1 + n_vir1) = index(k + 1 : k + n_vir1)
	k = k + n_vir1
	prt_map_in(2)%entry(n_in2 + 1 : n_in2 + n_vir2) = index(k + 1 : k + n_vir2)
	k = k + n_vir2
	prt_map_conn%entry = index(k + 1 : k + n_conn)
	k = k + n_conn
	prt_map_in(1)%entry(n_in1 + n_vir1 + 1 : n_rest(1)) = index(k + 1 : k + n_out1)
	k = k + n_out1
	prt_map_in(2)%entry(n_in2 + n_vir2 + 1 : n_rest(2)) = index(k + 1 : k + n_out2)
	end subroutine compute_index_bounds_and_mappings

	subroutine connection_table_init &
	(connection_table, state_in1, state_in2, qn_mask_conn, &
	n_conn, connection_index, n_rest, &
	qn_filter_conn, ignore_sub_for_qn_in)
	type(connection_table_t), intent(out) :: connection_table
	type(state_matrix_t), intent(in), target :: state_in1, state_in2
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_conn
	integer, intent(in) :: n_conn
	integer, dimension(:,:), intent(in) :: connection_index
	integer, dimension(2), intent(in) :: n_rest
	type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
	logical, intent(in), optional :: ignore_sub_for_qn_in
	integer, dimension(2) :: n_me_in
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(n_conn) :: qn
	integer :: i, me_index_in, me_index_conn, n_me_conn
	integer, dimension(2) :: me_count
	logical :: ignore_sub_for_qn, has_sub_qn
	integer :: i_beam_sub
	connection_table%n_conn = n_conn
	connection_table%n_rest = n_rest
	n_me_in(1) = state_in1%get_n_matrix_elements ()
	n_me_in(2) = state_in2%get_n_matrix_elements ()
	allocate (connection_table%index_conn (2))
	call index_map_init (connection_table%index_conn, n_me_in)
	call connection_table%state%init (n_counters = 2)
	do i = 1, 2
	select case (i)
	case (1); call it%init (state_in1)
	case (2); call it%init (state_in2)
	end select
	do while (it%is_valid ())
	qn = it%get_quantum_numbers (connection_index(:,i))
	call qn%undefine (qn_mask_conn)
	if (present (qn_filter_conn)) then
	if (.not. all (qn .match. qn_filter_conn)) then
	call it%advance (); cycle
	end if
	end if
	call quantum_numbers_canonicalize_color (qn)
	me_index_in = it%get_me_index ()
	ignore_sub_for_qn = .false.; if (present (ignore_sub_for_qn_in)) ignore_sub_for_qn = ignore_sub_for_qn_in
	has_sub_qn = .false.
	do i_beam_sub = 1, n_beams_rescaled
	has_sub_qn = has_sub_qn .or. any (qn%get_sub () == i_beam_sub)
	end do
	call connection_table%state%add_state (qn, &
	counter_index = i, &
	ignore_sub_for_qn = .not. (ignore_sub_for_qn .and. has_sub_qn), &
	me_index = me_index_conn)
	call index_map_set_entry (connection_table%index_conn(i), &
	me_index_in, me_index_conn)
	call it%advance ()
	end do
	end do
	n_me_conn = connection_table%state%get_n_matrix_elements ()
	connection_table%n_me_conn = n_me_conn
	allocate (connection_table%entry (n_me_conn))
	call it%init (connection_table%state)
	do while (it%is_valid ())
	i = it%get_me_index ()
	me_count = it%get_me_count ()
	call connection_entry_init (connection_table%entry(i), 2, 2, &
	it%get_quantum_numbers (), me_count, n_rest)
	call it%advance ()
	end do
	end subroutine connection_table_init

	subroutine connection_table_final (connection_table)
	type(connection_table_t), intent(inout) :: connection_table
	call connection_table%state%final ()
	end subroutine connection_table_final

	subroutine connection_table_write (connection_table, unit)
	type(connection_table_t), intent(in) :: connection_table
	integer, intent(in), optional :: unit
	integer :: i, j
	integer :: u
	u = given_output_unit (unit)
	write (u, *) "Connection table:"
	call connection_table%state%write (unit)
	if (allocated (connection_table%index_conn)) then
	write (u, *) " Index mapping input => connection table:"
	do i = 1, size (connection_table%index_conn)
	write (u, *) " Input state", i
	do j = 1, size (connection_table%index_conn(i))
	write (u, *) j, &
	index_map_get_entry (connection_table%index_conn(i), j)
	end do
	end do
	end if
	if (allocated (connection_table%entry)) then
	write (u, *) " Connection table contents:"
	do i = 1, size (connection_table%entry)
	call connection_entry_write (connection_table%entry(i), unit)
	end do
	end if
	if (index_map_exists (connection_table%index_result)) then
	write (u, *) " Index mapping connection table => output:"
	do i = 1, size (connection_table%index_result)
	write (u, *) i, &
	index_map_get_entry (connection_table%index_result, i)
	end do
	end if
	end subroutine connection_table_write

	subroutine connection_table_fill &
	(connection_table, state_in1, state_in2, &
	connection_index, prt_is_connected)
	type(connection_table_t), intent(inout) :: connection_table
	type(state_matrix_t), intent(in), target :: state_in1, state_in2
	integer, dimension(:,:), intent(in) :: connection_index
	type(prt_mask_t), dimension(2), intent(in) :: prt_is_connected
	type(state_iterator_t) :: it
	integer :: index_in, index_conn
	integer :: color_offset
	integer :: n_result_entries
	integer :: i, k
	color_offset = connection_table%state%get_max_color_value ()
	do i = 1, 2
	select case (i)
	case (1); call it%init (state_in1)
	case (2); call it%init (state_in2)
	end select
	do while (it%is_valid ())
	index_in = it%get_me_index ()
	index_conn = index_map_get_entry &
	(connection_table%index_conn(i), index_in)
	if (index_conn /= 0) then
	call connection_entry_add_state &
	(connection_table%entry(index_conn), i, &
	index_in, it%get_quantum_numbers (), &
	connection_index(:,i), prt_is_connected(i), &
	color_offset)
	end if
	call it%advance ()
	end do
	color_offset = color_offset + state_in1%get_max_color_value ()
	end do
	n_result_entries = 0
	do k = 1, size (connection_table%entry)
	n_result_entries = &
	n_result_entries + product (connection_table%entry(k)%n_index)
	end do
	call index_map_init (connection_table%index_result, n_result_entries)
	end subroutine connection_table_fill

	subroutine connection_entry_add_state &
	(entry, i, index_in, qn_in, connection_index, prt_is_connected, &
	color_offset)
	type(connection_entry_t), intent(inout) :: entry
	integer, intent(in) :: i
	integer, intent(in) :: index_in
	type(quantum_numbers_t), dimension(:), intent(in) :: qn_in
	integer, dimension(:), intent(in) :: connection_index
	type(prt_mask_t), intent(in) :: prt_is_connected
	integer, intent(in) :: color_offset
	integer :: c
	integer, dimension(:,:), allocatable :: color_map
	entry%count(i) = entry%count(i) + 1
	c = entry%count(i)
	call make_color_map (color_map, &
	qn_in(connection_index), entry%qn_conn)
	call index_map_set_entry (entry%index_in(i), c, index_in)
	entry%qn_in_list(i)%qn(:,c) = pack (qn_in, prt_is_connected%entry)
	call quantum_numbers_translate_color &
	(entry%qn_in_list(i)%qn(:,c), color_map, color_offset)
	end subroutine connection_entry_add_state

	subroutine make_product_interaction (int, &
	n_in, n_vir, n_out, &
	connection_table, &
	prt_map_in, prt_is_connected, &
	qn_mask_in, qn_mask_conn_initial, &
	qn_mask_conn, qn_filter_conn, qn_mask_rest)
	type(interaction_t), intent(out), target :: int
	integer, intent(in) :: n_in, n_vir, n_out
	type(connection_table_t), intent(inout), target :: connection_table
	type(index_map_t), dimension(2), intent(in) :: prt_map_in
	type(prt_mask_t), dimension(2), intent(in) :: prt_is_connected
	type(qn_mask_array_t), dimension(2), intent(in) :: qn_mask_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: &
	qn_mask_conn_initial
	type(quantum_numbers_mask_t), intent(in) :: qn_mask_conn
	type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
	type(quantum_numbers_mask_t), intent(in), optional :: qn_mask_rest
	type(index_map_t), dimension(2) :: prt_index_in
	type(index_map_t) :: prt_index_conn
	integer :: n_tot, n_conn
	integer, dimension(2) :: n_rest
	integer :: i, j, k, m
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
	type(connection_entry_t), pointer :: entry
	integer :: result_index
	n_conn = connection_table%n_conn
	n_rest = connection_table%n_rest
	n_tot = sum (n_rest) + n_conn
	allocate (qn (n_tot), qn_mask (n_tot))
	do i = 1, 2
	call index_map_init (prt_index_in(i), n_rest(i))
	prt_index_in(i)%entry = &
	prt_map_in(i)%entry ([ (j, j = 1, n_rest(i)) ])
	end do
	call index_map_init (prt_index_conn, n_conn)
	prt_index_conn%entry = prt_map_conn%entry ([ (j, j = 1, n_conn) ])
	do i = 1, 2
	if (present (qn_mask_rest)) then
	qn_mask(prt_index_in(i)%entry) = &
	pack (qn_mask_in(i)%mask, prt_is_connected(i)%entry) &
	.or. qn_mask_rest
	else
	qn_mask(prt_index_in(i)%entry) = &
	pack (qn_mask_in(i)%mask, prt_is_connected(i)%entry)
	end if
	end do
	qn_mask(prt_index_conn%entry) = qn_mask_conn_initial .or. qn_mask_conn
	call eval%interaction_t%basic_init (n_in, n_vir, n_out, mask = qn_mask)
	m = 1
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	qn(prt_index_conn%entry) = &
	quantum_numbers_undefined (entry%qn_conn, qn_mask_conn)
	if (present (qn_filter_conn)) then
	if (.not. all (qn(prt_index_conn%entry) .match. qn_filter_conn)) &
	cycle
	end if
	do j = 1, entry%n_index(1)
	qn(prt_index_in(1)%entry) = entry%qn_in_list(1)%qn(:,j)
	do k = 1, entry%n_index(2)
	qn(prt_index_in(2)%entry) = entry%qn_in_list(2)%qn(:,k)
	call int%add_state (qn, me_index = result_index)
	call index_map_set_entry &
	(connection_table%index_result, m, result_index)
	m = m + 1
	end do
	end do
	end do
	call int%freeze ()
	end subroutine make_product_interaction

	subroutine make_pairing_array (pa, n_matrix_elements, connection_table)
	type(pairing_array_t), dimension(:), intent(out), allocatable :: pa
	integer, intent(in) :: n_matrix_elements
	type(connection_table_t), intent(in), target :: connection_table
	type(connection_entry_t), pointer :: entry
	integer, dimension(:), allocatable :: n_entries
	integer :: i, j, k, m, r
	allocate (pa (n_matrix_elements))
	allocate (n_entries (n_matrix_elements))
	n_entries = 0
	do m = 1, size (connection_table%index_result)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	end do
	call pairing_array_init &
	(pa, n_entries, has_i2=.true., has_factor=.false.)
	m = 1
	n_entries = 0
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	do j = 1, entry%n_index(1)
	do k = 1, entry%n_index(2)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	pa(r)%i1(n_entries(r)) = &
	index_map_get_entry (entry%index_in(1), j)
	pa(r)%i2(n_entries(r)) = &
	index_map_get_entry (entry%index_in(2), k)
	m = m + 1
	end do
	end do
	end do
	end subroutine make_pairing_array

	subroutine record_links (int, &
	int_in1, int_in2, connection_index, prt_map_in, prt_map_conn, &
	prt_is_connected, connections_are_resonant)
	class(interaction_t), intent(inout) :: int
	class(interaction_t), intent(in), target :: int_in1, int_in2
	integer, dimension(:,:), intent(in) :: connection_index
	type(index_map_t), dimension(2), intent(in) :: prt_map_in
	type(index_map_t), intent(in) :: prt_map_conn
	type(prt_mask_t), dimension(2), intent(in) :: prt_is_connected
	logical, intent(in), optional :: connections_are_resonant
	type(index_map_t), dimension(2) :: prt_map_all
	integer :: i, j, k, ival
	call index_map_init (prt_map_all(1), size (prt_is_connected(1)))
	k = 0
	j = 0
	do i = 1, size (prt_is_connected(1))
	if (prt_is_connected(1)%entry(i)) then
	j = j + 1
	ival = index_map_get_entry (prt_map_in(1), j)
	call index_map_set_entry (prt_map_all(1), i, ival)
	else
	k = k + 1
	ival = index_map_get_entry (prt_map_conn, k)
	call index_map_set_entry (prt_map_all(1), i, ival)
	end if
	call int%set_source_link (ival, int_in1, i)
	end do
	call int_in1%transfer_relations (int, prt_map_all(1)%entry)
	call index_map_init (prt_map_all(2), size (prt_is_connected(2)))
	j = 0
	do i = 1, size (prt_is_connected(2))
	if (prt_is_connected(2)%entry(i)) then
	j = j + 1
	ival = index_map_get_entry (prt_map_in(2), j)
	call index_map_set_entry (prt_map_all(2), i, ival)
	call int%set_source_link (ival, int_in2, i)
	else
	call index_map_set_entry (prt_map_all(2), i, 0)
	end if
	end do
	call int_in2%transfer_relations (int, prt_map_all(2)%entry)
	call int%relate_connections &
	(int_in2, connection_index(:,2), prt_map_all(2)%entry, &
	prt_map_conn%entry, connections_are_resonant)
	end subroutine record_links

	end subroutine evaluator_init_product

	@ %def evaluator_init_product
	@
	\subsection{Creating an evaluator: square}
	The generic initializer for an evaluator that squares a matrix element.
	Depending on the provided mask, we select the appropriate specific initializer
	for either diagonal or non-diagonal helicity density matrices.
	<<Evaluators: evaluator: TBP>>=
	procedure :: init_square => evaluator_init_square
	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_init_square (eval, int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, dimension(:,:), intent(in), optional :: col_flow_index
	complex(default), dimension(:), intent(in), optional :: col_factor
	integer, dimension(:), intent(in), optional :: col_index_hi
	logical, intent(in), optional :: expand_color_flows
	integer, intent(in), optional :: nc
	end subroutine evaluator_init_square
	<<Evaluators: procedures>>=
	module subroutine evaluator_init_square (eval, int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, dimension(:,:), intent(in), optional :: col_flow_index
	complex(default), dimension(:), intent(in), optional :: col_factor
	integer, dimension(:), intent(in), optional :: col_index_hi
	logical, intent(in), optional :: expand_color_flows
	integer, intent(in), optional :: nc
	if (all (qn_mask%diagonal_helicity ())) then
	call eval%init_square_diag (int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)
	else
	call eval%init_square_nondiag (int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)
	end if
	end subroutine evaluator_init_square

	@ %def evaluator_init_square
	@
	\subsubsection{Color-summed squared matrix (diagonal helicities)}
	The initializer for an evaluator that squares a matrix element,
	including color factors. The mask must be such that off-diagonal matrix
	elements are excluded.

	If [[color_flows]] is set, the evaluator keeps color-flow entries
	separate and drops all interfering color structures. The color factors are
	set to unity in this case.

	There is only one input interaction. The quantum-number mask is an
	array, one entry for each particle, so they can be treated
	individually. For academic purposes, we allow for the number of
	colors being different from three (but 3 is the default).

	The algorithm is analogous to multiplication, with a few notable
	differences:
	\begin{enumerate}
	\item
	The connected particles are known, the correspondence is
	one-to-one. All particles are connected, and the mapping of indices
	is trivial, which simplifies the following steps.
	\item
	[[accumulate_connected_states]]: The matrix of connected states
	encompasses all particles, but color indices are removed. However,
	ghost states are still kept separate from physical color states. No
	color-index reassignment is necessary.
	\item
	The table of connections contains single index and quantum-number
	arrays instead of pairs of them. They are paired with themselves
	in all possible ways.
	\item
	[[make_squared_interaction]]: Now apply the predefined
	quantum-numbers mask, which usually collects all color states
	(physical and ghosts), and possibly a helicity sum.
	\item
	[[make_pairing_array]]: For each pair of input states, compute the
	color factor (including a potential ghost-parity sign) and store
	this in the pairing array together with the matrix-element indices
	for multiplication.
	\item
	[[record_links]]: This is again trivial due to the one-to-one
	correspondence.
	\end{enumerate}

	<<Evaluators: evaluator: TBP>>=
	procedure :: init_square_diag => evaluator_init_square_diag
	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_init_square_diag (eval, int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, dimension(:,:), intent(in), optional :: col_flow_index
	complex(default), dimension(:), intent(in), optional :: col_factor
	integer, dimension(:), intent(in), optional :: col_index_hi
	logical, intent(in), optional :: expand_color_flows
	integer, intent(in), optional :: nc
	end subroutine evaluator_init_square_diag
	<<Evaluators: procedures>>=
	module subroutine evaluator_init_square_diag (eval, int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)

	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, dimension(:,:), intent(in), optional :: col_flow_index
	complex(default), dimension(:), intent(in), optional :: col_factor
	integer, dimension(:), intent(in), optional :: col_index_hi
	logical, intent(in), optional :: expand_color_flows
	integer, intent(in), optional :: nc

	integer :: n_in, n_vir, n_out, n_tot
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask_initial
	type(state_matrix_t), pointer :: state_in
	type(connection_table_diag_t) :: connection_table

	logical :: sum_colors
	type(color_table_t) :: color_table

	if (present (expand_color_flows)) then
	sum_colors = .not. expand_color_flows
	else
	sum_colors = .true.
	end if

	if (sum_colors) then
	eval%type = EVAL_SQUARE_WITH_COLOR_FACTORS
	else
	eval%type = EVAL_SQUARED_FLOWS
	end if
	eval%int_in1 => int_in

	n_in = int_in%get_n_in ()
	n_vir = int_in%get_n_vir ()
	n_out = int_in%get_n_out ()
	n_tot = int_in%get_n_tot ()

	state_in => int_in%get_state_matrix_ptr ()

	allocate (qn_mask_initial (n_tot))
	qn_mask_initial = int_in%get_mask ()
	call qn_mask_initial%set_color (sum_colors, mask_cg=.false.)
	if (sum_colors) then
	call color_table_init (color_table, state_in, n_tot)
	if (present (col_flow_index) .and. present (col_factor) &
	.and. present (col_index_hi)) then
	call color_table_set_color_factors &
	(color_table, col_flow_index, col_factor, col_index_hi)
	end if
	end if

	call connection_table_init (connection_table, state_in, &
	qn_mask_initial, qn_mask, n_tot)
	call connection_table_fill (connection_table, state_in)
	call make_squared_interaction (eval%interaction_t, &
	n_in, n_vir, n_out, n_tot, &
	connection_table, sum_colors, qn_mask_initial .or. qn_mask)
	call make_pairing_array (eval%pairing_array, &
	eval%get_n_matrix_elements (), &
	connection_table, sum_colors, color_table, n_in, n_tot, nc)
	call record_links (eval, int_in, n_tot)
	call connection_table_final (connection_table)

	contains

	subroutine connection_table_init &
	(connection_table, state_in, qn_mask_in, qn_mask, n_tot)
	type(connection_table_diag_t), intent(out) :: connection_table
	type(state_matrix_t), intent(in), target :: state_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, intent(in) :: n_tot
	type(quantum_numbers_t), dimension(n_tot) :: qn
	type(state_iterator_t) :: it
	integer :: i, n_me_in, me_index_in
	integer :: me_index_conn, n_me_conn
	integer, dimension(1) :: me_count
	logical :: qn_passed
	connection_table%n_tot = n_tot
	n_me_in = state_in%get_n_matrix_elements ()
	call index_map_init (connection_table%index_conn, n_me_in)
	call connection_table%state%init (n_counters=1)
	call it%init (state_in)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	if (all (quantum_numbers_are_physical (qn, qn_mask))) then
	call qn%undefine (qn_mask_in)
	qn_passed = .true.
	if (qn_passed) then
	me_index_in = it%get_me_index ()
	call connection_table%state%add_state (qn, &
	counter_index = 1, me_index = me_index_conn)
	call index_map_set_entry (connection_table%index_conn, &
	me_index_in, me_index_conn)
	end if
	end if
	call it%advance ()
	end do
	n_me_conn = connection_table%state%get_n_matrix_elements ()
	connection_table%n_me_conn = n_me_conn
	allocate (connection_table%entry (n_me_conn))
	call it%init (connection_table%state)
	do while (it%is_valid ())
	i = it%get_me_index ()
	me_count = it%get_me_count ()
	call connection_entry_init (connection_table%entry(i), 1, 2, &
	it%get_quantum_numbers (), me_count, [n_tot])
	call it%advance ()
	end do
	end subroutine connection_table_init

	subroutine connection_table_final (connection_table)
	type(connection_table_diag_t), intent(inout) :: connection_table
	call connection_table%state%final ()
	end subroutine connection_table_final

	subroutine connection_table_write (connection_table, unit)
	type(connection_table_diag_t), intent(in) :: connection_table
	integer, intent(in), optional :: unit
	integer :: i
	integer :: u
	u = given_output_unit (unit)
	write (u, *) "Connection table:"
	call connection_table%state%write (unit)
	if (index_map_exists (connection_table%index_conn)) then
	write (u, *) " Index mapping input => connection table:"
	do i = 1, size (connection_table%index_conn)
	write (u, *) i, &
	index_map_get_entry (connection_table%index_conn, i)
	end do
	end if
	if (allocated (connection_table%entry)) then
	write (u, *) " Connection table contents"
	do i = 1, size (connection_table%entry)
	call connection_entry_write (connection_table%entry(i), unit)
	end do
	end if
	if (index_map_exists (connection_table%index_result)) then
	write (u, *) " Index mapping connection table => output"
	do i = 1, size (connection_table%index_result)
	write (u, *) i, &
	index_map_get_entry (connection_table%index_result, i)
	end do
	end if
	end subroutine connection_table_write

	subroutine connection_table_fill (connection_table, state)
	type(connection_table_diag_t), intent(inout) :: connection_table
	type(state_matrix_t), intent(in), target :: state
	integer :: index_in, index_conn, n_result_entries
	type(state_iterator_t) :: it
	integer :: k
	call it%init (state)
	do while (it%is_valid ())
	index_in = it%get_me_index ()
	index_conn = &
	index_map_get_entry (connection_table%index_conn, index_in)
	if (index_conn /= 0) then
	call connection_entry_add_state &
	(connection_table%entry(index_conn), &
	index_in, it%get_quantum_numbers ())
	end if
	call it%advance ()
	end do
	n_result_entries = 0
	do k = 1, size (connection_table%entry)
	n_result_entries = &
	n_result_entries + connection_table%entry(k)%n_index(1) ** 2
	end do
	call index_map_init (connection_table%index_result, n_result_entries)
	end subroutine connection_table_fill

	subroutine connection_entry_add_state (entry, index_in, qn_in)
	type(connection_entry_t), intent(inout) :: entry
	integer, intent(in) :: index_in
	type(quantum_numbers_t), dimension(:), intent(in) :: qn_in
	integer :: c
	entry%count = entry%count + 1
	c = entry%count(1)
	call index_map_set_entry (entry%index_in(1), c, index_in)
	entry%qn_in_list(1)%qn(:,c) = qn_in
	end subroutine connection_entry_add_state

	subroutine make_squared_interaction (int, &
	n_in, n_vir, n_out, n_tot, &
	connection_table, sum_colors, qn_mask)
	type(interaction_t), intent(out), target :: int
	integer, intent(in) :: n_in, n_vir, n_out, n_tot
	type(connection_table_diag_t), intent(inout), target :: connection_table
	logical, intent(in) :: sum_colors
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	type(connection_entry_t), pointer :: entry
	integer :: result_index, n_contrib
	integer :: i, m
	type(quantum_numbers_t), dimension(n_tot) :: qn
	call eval%interaction_t%basic_init (n_in, n_vir, n_out, mask=qn_mask)
	m = 0
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	qn = quantum_numbers_undefined (entry%qn_conn, qn_mask)
	if (.not. sum_colors) call qn(1:n_in)%invert_color ()
	call int%add_state (qn, me_index = result_index)
	n_contrib = entry%n_index(1) ** 2
	connection_table%index_result%entry(m+1:m+n_contrib) = result_index
	m = m + n_contrib
	end do
	call int%freeze ()
	end subroutine make_squared_interaction

	subroutine make_pairing_array (pa, &
	n_matrix_elements, connection_table, sum_colors, color_table, &
	n_in, n_tot, nc)
	type(pairing_array_t), dimension(:), intent(out), allocatable :: pa
	integer, intent(in) :: n_matrix_elements
	type(connection_table_diag_t), intent(in), target :: connection_table
	logical, intent(in) :: sum_colors
	type(color_table_t), intent(inout) :: color_table
	type(connection_entry_t), pointer :: entry
	integer, intent(in) :: n_in, n_tot
	integer, intent(in), optional :: nc
	integer, dimension(:), allocatable :: n_entries
	integer :: i, k, l, ks, ls, m, r
	integer :: color_multiplicity_in
	allocate (pa (n_matrix_elements))
	allocate (n_entries (n_matrix_elements))
	n_entries = 0
	do m = 1, size (connection_table%index_result)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	end do
	call pairing_array_init &
	(pa, n_entries, has_i2 = sum_colors, has_factor = sum_colors)
	m = 1
	n_entries = 0
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	do k = 1, entry%n_index(1)
	if (sum_colors) then
	color_multiplicity_in = product (abs &
	(entry%qn_in_list(1)%qn(:n_in, k)%get_color_type ()))
	do l = 1, entry%n_index(1)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	ks = index_map_get_entry (entry%index_in(1), k)
	ls = index_map_get_entry (entry%index_in(1), l)
	pa(r)%i1(n_entries(r)) = ks
	pa(r)%i2(n_entries(r)) = ls
	pa(r)%factor(n_entries(r)) = &
	color_table_get_color_factor (color_table, ks, ls, nc) &
	/ color_multiplicity_in
	m = m + 1
	end do
	else
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	ks = index_map_get_entry (entry%index_in(1), k)
	pa(r)%i1(n_entries(r)) = ks
	m = m + 1
	end if
	end do
	end do
	end subroutine make_pairing_array

	subroutine record_links (int, int_in, n_tot)
	class(interaction_t), intent(inout) :: int
	class(interaction_t), intent(in), target :: int_in
	integer, intent(in) :: n_tot
	integer, dimension(n_tot) :: map
	integer :: i
	do i = 1, n_tot
	call int%set_source_link (i, int_in, i)
	end do
	map = [ (i, i = 1, n_tot) ]
	call int_in%transfer_relations (int, map)
	end subroutine record_links

	end subroutine evaluator_init_square_diag

	@ %def evaluator_init_square_diag
	@
	\subsubsection{Color-summed squared matrix (support nodiagonal helicities)}
	The initializer for an evaluator that squares a matrix element,
	including color factors. Unless requested otherwise by the
	quantum-number mask, the result contains off-diagonal matrix elements.
	(The input interaction must be diagonal since it represents an
	amplitude, not a density matrix.)

	There is only one input interaction. The quantum-number mask is an
	array, one entry for each particle, so they can be treated
	individually. For academic purposes, we allow for the number of
	colors being different from three (but 3 is the default).

	The algorithm is analogous to the previous one, with some additional
	complications due to the necessity to loop over two helicity indices.
	<<Evaluators: evaluator: TBP>>=
	procedure :: init_square_nondiag => evaluator_init_square_nondiag
	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_init_square_nondiag (eval, int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, dimension(:,:), intent(in), optional :: col_flow_index
	complex(default), dimension(:), intent(in), optional :: col_factor
	integer, dimension(:), intent(in), optional :: col_index_hi
	logical, intent(in), optional :: expand_color_flows
	integer, intent(in), optional :: nc
	end subroutine evaluator_init_square_nondiag
	<<Evaluators: procedures>>=
	module subroutine evaluator_init_square_nondiag (eval, int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)

	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, dimension(:,:), intent(in), optional :: col_flow_index
	complex(default), dimension(:), intent(in), optional :: col_factor
	integer, dimension(:), intent(in), optional :: col_index_hi
	logical, intent(in), optional :: expand_color_flows
	integer, intent(in), optional :: nc

	integer :: n_in, n_vir, n_out, n_tot
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask_initial
	type(state_matrix_t), pointer :: state_in
	type(connection_table_nondiag_t) :: connection_table

	logical :: sum_colors
	type(color_table_t) :: color_table

	if (present (expand_color_flows)) then
	sum_colors = .not. expand_color_flows
	else
	sum_colors = .true.
	end if

	if (sum_colors) then
	eval%type = EVAL_SQUARE_WITH_COLOR_FACTORS
	else
	eval%type = EVAL_SQUARED_FLOWS
	end if
	eval%int_in1 => int_in

	n_in = int_in%get_n_in ()
	n_vir = int_in%get_n_vir ()
	n_out = int_in%get_n_out ()
	n_tot = int_in%get_n_tot ()

	state_in => int_in%get_state_matrix_ptr ()

	allocate (qn_mask_initial (n_tot))
	qn_mask_initial = int_in%get_mask ()
	call qn_mask_initial%set_color (sum_colors, mask_cg=.false.)
	if (sum_colors) then
	call color_table_init (color_table, state_in, n_tot)
	if (present (col_flow_index) .and. present (col_factor) &
	.and. present (col_index_hi)) then
	call color_table_set_color_factors &
	(color_table, col_flow_index, col_factor, col_index_hi)
	end if
	end if

	call connection_table_init (connection_table, state_in, &
	qn_mask_initial, qn_mask, n_tot)
	call connection_table_fill (connection_table, state_in)
	call make_squared_interaction (eval%interaction_t, &
	n_in, n_vir, n_out, n_tot, &
	connection_table, sum_colors, qn_mask_initial .or. qn_mask)
	call make_pairing_array (eval%pairing_array, &
	eval%get_n_matrix_elements (), &
	connection_table, sum_colors, color_table, n_in, n_tot, nc)
	call record_links (eval, int_in, n_tot)
	call connection_table_final (connection_table)

	contains

	subroutine connection_table_init &
	(connection_table, state_in, qn_mask_in, qn_mask, n_tot)
	type(connection_table_nondiag_t), intent(out) :: connection_table
	type(state_matrix_t), intent(in), target :: state_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, intent(in) :: n_tot
	type(quantum_numbers_t), dimension(n_tot) :: qn1, qn2, qn
	type(state_iterator_t) :: it1, it2, it
	integer :: i, n_me_in, me_index_in1, me_index_in2
	integer :: me_index_conn, n_me_conn
	integer, dimension(1) :: me_count
	logical :: qn_passed
	connection_table%n_tot = n_tot
	n_me_in = state_in%get_n_matrix_elements ()
	call index_map2_init (connection_table%index_conn, n_me_in)
	connection_table%index_conn = 0
	call connection_table%state%init (n_counters=1)
	call it1%init (state_in)
	do while (it1%is_valid ())
	qn1 = it1%get_quantum_numbers ()
	me_index_in1 = it1%get_me_index ()
	call it2%init (state_in)
	do while (it2%is_valid ())
	qn2 = it2%get_quantum_numbers ()
	if (all (quantum_numbers_are_compatible (qn1, qn2, qn_mask))) then
	qn = qn1 .merge. qn2
	call qn%undefine (qn_mask_in)
	qn_passed = .true.
	if (qn_passed) then
	me_index_in2 = it2%get_me_index ()
	call connection_table%state%add_state (qn, &
	counter_index = 1, me_index = me_index_conn)
	call index_map2_set_entry (connection_table%index_conn, &
	me_index_in1, me_index_in2, me_index_conn)
	end if
	end if
	call it2%advance ()
	end do
	call it1%advance ()
	end do
	n_me_conn = connection_table%state%get_n_matrix_elements ()
	connection_table%n_me_conn = n_me_conn
	allocate (connection_table%entry (n_me_conn))
	call it%init (connection_table%state)
	do while (it%is_valid ())
	i = it%get_me_index ()
	me_count = it%get_me_count ()
	call connection_entry_init (connection_table%entry(i), 1, 2, &
	it%get_quantum_numbers (), me_count, [n_tot])
	call it%advance ()
	end do
	end subroutine connection_table_init

	subroutine connection_table_final (connection_table)
	type(connection_table_nondiag_t), intent(inout) :: connection_table
	call connection_table%state%final ()
	end subroutine connection_table_final

	subroutine connection_table_write (connection_table, unit)
	type(connection_table_nondiag_t), intent(in) :: connection_table
	integer, intent(in), optional :: unit
	integer :: i, j
	integer :: u
	u = given_output_unit (unit)
	write (u, *) "Connection table:"
	call connection_table%state%write (unit)
	if (index_map2_exists (connection_table%index_conn)) then
	write (u, *) " Index mapping input => connection table:"
	do i = 1, size (connection_table%index_conn)
	do j = 1, size (connection_table%index_conn)
	write (u, *) i, j, &
	index_map2_get_entry (connection_table%index_conn, i, j)
	end do
	end do
	end if
	if (allocated (connection_table%entry)) then
	write (u, *) " Connection table contents"
	do i = 1, size (connection_table%entry)
	call connection_entry_write (connection_table%entry(i), unit)
	end do
	end if
	if (index_map_exists (connection_table%index_result)) then
	write (u, *) " Index mapping connection table => output"
	do i = 1, size (connection_table%index_result)
	write (u, *) i, &
	index_map_get_entry (connection_table%index_result, i)
	end do
	end if
	end subroutine connection_table_write

	subroutine connection_table_fill (connection_table, state)
	type(connection_table_nondiag_t), intent(inout), target :: connection_table
	type(state_matrix_t), intent(in), target :: state
	integer :: index1_in, index2_in, index_conn, n_result_entries
	type(state_iterator_t) :: it1, it2
	integer :: k
	call it1%init (state)
	do while (it1%is_valid ())
	index1_in = it1%get_me_index ()
	call it2%init (state)
	do while (it2%is_valid ())
	index2_in = it2%get_me_index ()
	index_conn = index_map2_get_entry &
	(connection_table%index_conn, index1_in, index2_in)
	if (index_conn /= 0) then
	call connection_entry_add_state &
	(connection_table%entry(index_conn), &
	index1_in, index2_in, &
	it1%get_quantum_numbers () &
	.merge. &
	it2%get_quantum_numbers ())
	end if
	call it2%advance ()
	end do
	call it1%advance ()
	end do
	n_result_entries = 0
	do k = 1, size (connection_table%entry)
	n_result_entries = &
	n_result_entries + connection_table%entry(k)%n_index(1)
	end do
	call index_map_init (connection_table%index_result, n_result_entries)
	end subroutine connection_table_fill

	subroutine connection_entry_add_state (entry, index1_in, index2_in, qn_in)
	type(connection_entry_t), intent(inout) :: entry
	integer, intent(in) :: index1_in, index2_in
	type(quantum_numbers_t), dimension(:), intent(in) :: qn_in
	integer :: c
	entry%count = entry%count + 1
	c = entry%count(1)
	call index_map_set_entry (entry%index_in(1), c, index1_in)
	call index_map_set_entry (entry%index_in(2), c, index2_in)
	entry%qn_in_list(1)%qn(:,c) = qn_in
	end subroutine connection_entry_add_state

	subroutine make_squared_interaction (int, &
	n_in, n_vir, n_out, n_tot, &
	connection_table, sum_colors, qn_mask)
	type(interaction_t), intent(out), target :: int
	integer, intent(in) :: n_in, n_vir, n_out, n_tot
	type(connection_table_nondiag_t), intent(inout), target :: connection_table
	logical, intent(in) :: sum_colors
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	type(connection_entry_t), pointer :: entry
	integer :: result_index
	integer :: i, k, m
	type(quantum_numbers_t), dimension(n_tot) :: qn
	call eval%interaction_t%basic_init (n_in, n_vir, n_out, mask=qn_mask)
	m = 0
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	do k = 1, size (entry%qn_in_list(1)%qn, 2)
	qn = quantum_numbers_undefined &
	(entry%qn_in_list(1)%qn(:,k), qn_mask)
	if (.not. sum_colors) call qn(1:n_in)%invert_color ()
	call int%add_state (qn, me_index = result_index)
	call index_map_set_entry (connection_table%index_result, m + 1, &
	result_index)
	m = m + 1
	end do
	end do
	call int%freeze ()
	end subroutine make_squared_interaction

	subroutine make_pairing_array (pa, &
	n_matrix_elements, connection_table, sum_colors, color_table, &
	n_in, n_tot, nc)
	type(pairing_array_t), dimension(:), intent(out), allocatable :: pa
	integer, intent(in) :: n_matrix_elements
	type(connection_table_nondiag_t), intent(in), target :: connection_table
	logical, intent(in) :: sum_colors
	type(color_table_t), intent(inout) :: color_table
	type(connection_entry_t), pointer :: entry
	integer, intent(in) :: n_in, n_tot
	integer, intent(in), optional :: nc
	integer, dimension(:), allocatable :: n_entries
	integer :: i, k, k1s, k2s, m, r
	integer :: color_multiplicity_in
	allocate (pa (n_matrix_elements))
	allocate (n_entries (n_matrix_elements))
	n_entries = 0
	do m = 1, size (connection_table%index_result)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	end do
	call pairing_array_init &
	(pa, n_entries, has_i2 = sum_colors, has_factor = sum_colors)
	m = 1
	n_entries = 0
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	do k = 1, entry%n_index(1)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	if (sum_colors) then
	k1s = index_map_get_entry (entry%index_in(1), k)
	k2s = index_map_get_entry (entry%index_in(2), k)
	pa(r)%i1(n_entries(r)) = k1s
	pa(r)%i2(n_entries(r)) = k2s
	color_multiplicity_in = product (abs &
	(entry%qn_in_list(1)%qn(:n_in, k)%get_color_type ()))
	pa(r)%factor(n_entries(r)) = &
	color_table_get_color_factor (color_table, k1s, k2s, nc) &
	/ color_multiplicity_in
	else
	k1s = index_map_get_entry (entry%index_in(1), k)
	pa(r)%i1(n_entries(r)) = k1s
	end if
	m = m + 1
	end do
	end do
	end subroutine make_pairing_array

	subroutine record_links (int, int_in, n_tot)
	class(interaction_t), intent(inout) :: int
	class(interaction_t), intent(in), target :: int_in
	integer, intent(in) :: n_tot
	integer, dimension(n_tot) :: map
	integer :: i
	do i = 1, n_tot
	call int%set_source_link (i, int_in, i)
	end do
	map = [ (i, i = 1, n_tot) ]
	call int_in%transfer_relations (int, map)
	end subroutine record_links

	end subroutine evaluator_init_square_nondiag

	@ %def evaluator_init_square_nondiag
	@
	\subsubsection{Copy with additional contracted color states}
	This evaluator involves no square or multiplication, its matrix
	elements are just copies of the (single) input interaction. However,
	the state matrix of the interaction contains additional states that
	have color indices contracted. This is used for copies of the beam or
	structure-function interactions that need to match the hard
	interaction also in the case where its color indices coincide.
	<<Evaluators: evaluator: TBP>>=
	procedure :: init_color_contractions => evaluator_init_color_contractions
	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_init_color_contractions (eval, int_in)
	class(evaluator_t), intent(out), target :: eval
	type(interaction_t), intent(in), target :: int_in
	end subroutine evaluator_init_color_contractions
	<<Evaluators: procedures>>=
	module subroutine evaluator_init_color_contractions (eval, int_in)
	class(evaluator_t), intent(out), target :: eval
	type(interaction_t), intent(in), target :: int_in
	integer :: n_in, n_vir, n_out, n_tot
	type(state_matrix_t) :: state_with_contractions
	integer, dimension(:), allocatable :: me_index
	integer, dimension(:), allocatable :: result_index
	eval%type = EVAL_COLOR_CONTRACTION
	eval%int_in1 => int_in
	n_in = int_in%get_n_in ()
	n_vir = int_in%get_n_vir ()
	n_out = int_in%get_n_out ()
	n_tot = int_in%get_n_tot ()
	state_with_contractions = int_in%get_state_matrix_ptr ()
	call state_with_contractions%add_color_contractions ()
	call make_contracted_interaction (eval%interaction_t, &
	me_index, result_index, &
	n_in, n_vir, n_out, n_tot, &
	state_with_contractions, int_in%get_mask ())
	call make_pairing_array (eval%pairing_array, me_index, result_index)
	call record_links (eval, int_in, n_tot)
	call state_with_contractions%final ()

	contains

	subroutine make_contracted_interaction (int, &
	me_index, result_index, &
	n_in, n_vir, n_out, n_tot, state, qn_mask)
	type(interaction_t), intent(out), target :: int
	integer, dimension(:), intent(out), allocatable :: me_index
	integer, dimension(:), intent(out), allocatable :: result_index
	integer, intent(in) :: n_in, n_vir, n_out, n_tot
	type(state_matrix_t), intent(in) :: state
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	type(state_iterator_t) :: it
	integer :: n_me, i
	type(quantum_numbers_t), dimension(n_tot) :: qn
	call int%basic_init (n_in, n_vir, n_out, mask=qn_mask)
	n_me = state%get_n_leaves ()
	allocate (me_index (n_me))
	allocate (result_index (n_me))
	call it%init (state)
	i = 0
	do while (it%is_valid ())
	i = i + 1
	me_index(i) = it%get_me_index ()
	qn = it%get_quantum_numbers ()
	call int%add_state (qn, me_index = result_index(i))
	call it%advance ()
	end do
	call int%freeze ()
	end subroutine make_contracted_interaction

	subroutine make_pairing_array (pa, me_index, result_index)
	type(pairing_array_t), dimension(:), intent(out), allocatable :: pa
	integer, dimension(:), intent(in) :: me_index, result_index
	integer, dimension(:), allocatable :: n_entries
	integer :: n_matrix_elements, r, i, k
	!!! The result indices of the appended color contracted states
	!!! start counting from 1 again. For the pairing array, we currently
	!!! only take the first part of ascending indices into account
	!!! excluding the color contracted states.
	n_matrix_elements = size (me_index)
	k = 0
	do i = 1, n_matrix_elements
	r = result_index(i)
	if (r < i) exit
	k = r
	end do
	allocate (pa (k))
	allocate (n_entries (k))
	n_entries = 1
	call pairing_array_init &
	(pa, n_entries, has_i2=.false., has_factor=.false.)
	do i = 1, k
	r = result_index(i)
	pa(r)%i1(1) = me_index(i)
	end do
	end subroutine make_pairing_array

	subroutine record_links (int, int_in, n_tot)
	class(interaction_t), intent(inout) :: int
	class(interaction_t), intent(in), target :: int_in
	integer, intent(in) :: n_tot
	integer, dimension(n_tot) :: map
	integer :: i
	do i = 1, n_tot
	call int%set_source_link (i, int_in, i)
	end do
	map = [ (i, i = 1, n_tot) ]
	call int_in%transfer_relations (int, map)
	end subroutine record_links

	end subroutine evaluator_init_color_contractions

	@ %def evaluator_init_color_contractions
	@
	\subsubsection{Auxiliary procedure for initialization}
	This will become a standard procedure in F2008. The result is true if
	the number of true values in the mask is odd. We use the function for
	determining the ghost parity of a quantum-number array.

	[tho:] It's not used anymore and [[mod (count (mask), 2) == 1]] is
	a cooler implementation anyway.
	<<(UNUSED) Evaluators: procedures>>=
	function parity (mask)
	logical :: parity
	logical, dimension(:) :: mask
	integer :: i
	parity = .false.
	do i = 1, size (mask)
	if (mask(i)) parity = .not. parity
	end do
	end function parity

	@ %def parity
	@ Reassign external source links from one to another.
	<<Evaluators: public>>=
	public :: evaluator_reassign_links
	<<Evaluators: interfaces>>=
	interface evaluator_reassign_links
	module procedure evaluator_reassign_links_eval
	module procedure evaluator_reassign_links_int
	end interface

	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_reassign_links_eval (eval, eval_src, eval_target)
	type(evaluator_t), intent(inout) :: eval
	type(evaluator_t), intent(in) :: eval_src
	type(evaluator_t), intent(in), target :: eval_target
	end subroutine evaluator_reassign_links_eval
	module subroutine evaluator_reassign_links_int (eval, int_src, int_target)
	type(evaluator_t), intent(inout) :: eval
	type(interaction_t), intent(in) :: int_src
	type(interaction_t), intent(in), target :: int_target
	end subroutine evaluator_reassign_links_int
	<<Evaluators: procedures>>=
	module subroutine evaluator_reassign_links_eval (eval, eval_src, eval_target)
	type(evaluator_t), intent(inout) :: eval
	type(evaluator_t), intent(in) :: eval_src
	type(evaluator_t), intent(in), target :: eval_target
	if (associated (eval%int_in1)) then
	if (eval%int_in1%get_tag () == eval_src%get_tag ()) then
	eval%int_in1 => eval_target%interaction_t
	end if
	end if
	if (associated (eval%int_in2)) then
	if (eval%int_in2%get_tag () == eval_src%get_tag ()) then
	eval%int_in2 => eval_target%interaction_t
	end if
	end if
	call interaction_reassign_links &
	(eval%interaction_t, eval_src%interaction_t, &
	eval_target%interaction_t)
	end subroutine evaluator_reassign_links_eval

	module subroutine evaluator_reassign_links_int (eval, int_src, int_target)
	type(evaluator_t), intent(inout) :: eval
	type(interaction_t), intent(in) :: int_src
	type(interaction_t), intent(in), target :: int_target
	if (associated (eval%int_in1)) then
	if (eval%int_in1%get_tag () == int_src%get_tag ()) then
	eval%int_in1 => int_target
	end if
	end if
	if (associated (eval%int_in2)) then
	if (eval%int_in2%get_tag () == int_src%get_tag ()) then
	eval%int_in2 => int_target
	end if
	end if
	call interaction_reassign_links (eval%interaction_t, int_src, int_target)
	end subroutine evaluator_reassign_links_int

	@ %def evaluator_reassign_links
	@
	<<Evaluators: public>>=
	public :: evaluator_get_int_in_ptr
	<<Evaluators: sub interfaces>>=
	module function evaluator_get_int_in_ptr (eval, i) result (int_in)
	class(interaction_t), pointer :: int_in
	type(evaluator_t), intent(in), target :: eval
	integer, intent(in) :: i
	end function evaluator_get_int_in_ptr
	<<Evaluators: procedures>>=
	module function evaluator_get_int_in_ptr (eval, i) result (int_in)
	class(interaction_t), pointer :: int_in
	type(evaluator_t), intent(in), target :: eval
	integer, intent(in) :: i
	if (i == 1) then
	int_in => eval%int_in1
	else if (i == 2) then
	int_in => eval%int_in2
	else
	int_in => null ()
	end if
	end function evaluator_get_int_in_ptr

	@ %def evaluator_get_int_in_ptr
	@
	\subsection{Creating an evaluator: identity}
	The identity evaluator creates a copy of the first input evaluator; the second
	input is not used.

	All particles link back to the input evaluatorand the internal
	relations are copied. As evaluation does take a shortcut by cloning the matrix
	elements, the pairing array is not used and does not have to be set up.

	<<Evaluators: evaluator: TBP>>=
	procedure :: init_identity => evaluator_init_identity
	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_init_identity (eval, int)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int
	end subroutine evaluator_init_identity
	<<Evaluators: procedures>>=
	module subroutine evaluator_init_identity (eval, int)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int
	integer :: n_in, n_out, n_vir, n_tot
	integer :: i
	integer, dimension(:), allocatable :: map
	type(state_matrix_t), pointer :: state
	type(state_iterator_t) :: it
	eval%type = EVAL_IDENTITY
	eval%int_in1 => int
	nullify (eval%int_in2)
	n_in = int%get_n_in ()
	n_out = int%get_n_out ()
	n_vir = int%get_n_vir ()
	n_tot = int%get_n_tot ()
	call eval%interaction_t%basic_init (n_in, n_vir, n_out, &
	mask = int%get_mask (), &
	resonant = int%get_resonance_flags ())
	do i = 1, n_tot
	call eval%set_source_link (i, int, i)
	end do
	allocate (map(n_tot))
	map = [(i, i = 1, n_tot)]
	call int%transfer_relations (eval, map)
	state => int%get_state_matrix_ptr ()
	call it%init (state)
	do while (it%is_valid ())
	call eval%add_state (it%get_quantum_numbers (), &
	it%get_me_index ())
	call it%advance ()
	end do
	call eval%freeze ()

	end subroutine evaluator_init_identity

	@ %def evaluator_init_identity
	@
	\subsection {Creating an evaluator: quantum number sum}
	This evaluator operates on the diagonal of a density matrix and sums over the
	quantum numbers specified by the mask. The optional argument [[drop]] allows to
	drop a particle from the resulting density matrix. The handling of virtuals is
	not completely sane, especially in connection with dropping particles.

	When summing over matrix element entries, we keep the separation into
	entries and normalization (in the corresponding evaluation routine below).
	<<Evaluators: evaluator: TBP>>=
	procedure :: init_qn_sum => evaluator_init_qn_sum
	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_init_qn_sum (eval, int, qn_mask, drop)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), target, intent(in) :: int
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	logical, intent(in), optional, dimension(:) :: drop
	end subroutine evaluator_init_qn_sum
	<<Evaluators: procedures>>=
	module subroutine evaluator_init_qn_sum (eval, int, qn_mask, drop)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), target, intent(in) :: int
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	logical, intent(in), optional, dimension(:) :: drop
	type(state_iterator_t) :: it_old, it_new
	integer, dimension(:), allocatable :: pairing_size, pairing_target, i_new
	integer, dimension(:), allocatable :: map
	integer :: n_in, n_out, n_vir, n_tot, n_me_old, n_me_new
	integer :: i, j
	type(state_matrix_t), pointer :: state_new, state_old
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	logical :: matched
	logical, dimension(size (qn_mask)) :: dropped
	integer :: ndropped
	integer, dimension(:), allocatable :: inotdropped
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
	logical, dimension(:), allocatable :: resonant

	eval%type = EVAL_QN_SUM
	eval%int_in1 => int
	nullify (eval%int_in2)
	if (present (drop)) then
	dropped = drop
	else
	dropped = .false.
	end if
	ndropped = count (dropped)

	n_in = int%get_n_in ()
	n_out = int%get_n_out () - ndropped
	n_vir = int%get_n_vir ()
	n_tot = int%get_n_tot () - ndropped

	allocate (inotdropped (n_tot))
	i = 1
	do j = 1, n_tot + ndropped
	if (dropped (j)) cycle
	inotdropped(i) = j
	i = i + 1
	end do

	allocate (mask(n_tot + ndropped))
	mask = int%get_mask ()
	allocate (resonant(n_tot + ndropped))
	resonant = int%get_resonance_flags ()
	call eval%interaction_t%basic_init (n_in, n_vir, n_out, &
	mask = mask(inotdropped) .or. qn_mask(inotdropped), &
	resonant = resonant(inotdropped))
	i = 1
	do j = 1, n_tot + ndropped
	if (dropped(j)) cycle
	call eval%set_source_link (i, int, j)
	i = i + 1
	end do
	allocate (map(n_tot + ndropped))
	i = 1
	do j = 1, n_tot + ndropped
	if (dropped (j)) then
	map(j) = 0
	else
	map(j) = i
	i = i + 1
	end if
	end do
	call int%transfer_relations (eval, map)

	n_me_old = int%get_n_matrix_elements ()
	allocate (pairing_size (n_me_old), source = 0)
	allocate (pairing_target (n_me_old), source = 0)
	pairing_size = 0
	state_old => int%get_state_matrix_ptr ()
	state_new => eval%get_state_matrix_ptr ()
	call it_old%init (state_old)
	allocate (qn(n_tot + ndropped))
	do while (it_old%is_valid ())
	qn = it_old%get_quantum_numbers ()
	if (.not. all (qn%are_diagonal ())) then
	call it_old%advance ()
	cycle
	end if
	matched = .false.
	call it_new%init (state_new)
	if (eval%get_n_matrix_elements () > 0) then
	do while (it_new%is_valid ())
	if (all (qn(inotdropped) .match. &
	it_new%get_quantum_numbers ())) &
	then
	matched = .true.
	i = it_new%get_me_index ()
	exit
	end if
	call it_new%advance ()
	end do
	end if
	if (.not. matched) then
	call eval%add_state (qn(inotdropped))
	i = eval%get_n_matrix_elements ()
	end if
	pairing_size(i) = pairing_size(i) + 1
	pairing_target(it_old%get_me_index ()) = i
	call it_old%advance ()
	end do
	call eval%freeze ()

	n_me_new = eval%get_n_matrix_elements ()
	allocate (eval%pairing_array (n_me_new))
	do i = 1, n_me_new
	call pairing_array_init (eval%pairing_array(i), &
	pairing_size(i), .false., .false.)
	end do

	allocate (i_new (n_me_new), source = 0)
	do i = 1, n_me_old
	j = pairing_target(i)
	if (j > 0) then
	i_new(j) = i_new(j) + 1
	eval%pairing_array(j)%i1(i_new(j)) = i
	end if
	end do

	end subroutine evaluator_init_qn_sum

	@ %def evaluator_init_qn_sum
	@
	\subsection{Evaluation}
	When the input interactions (which are pointed to in the pairings
	stored within the evaluator) are filled with values, we can activate
	the evaluator, i.e., calculate the result values which are stored in
	the interaction.

	The evaluation of matrix elements can be done in parallel. A
	[[forall]] construct is not appropriate, however. We would need
	[[do concurrent]] here. Nevertheless, the evaluation functions are
	marked as [[pure]].
	<<Evaluators: evaluator: TBP>>=
	procedure :: evaluate => evaluator_evaluate
	<<Evaluators: sub interfaces>>=
	module subroutine evaluator_evaluate (eval)
	class(evaluator_t), intent(inout), target :: eval
	end subroutine evaluator_evaluate
	<<Evaluators: procedures>>=
	module subroutine evaluator_evaluate (eval)
	class(evaluator_t), intent(inout), target :: eval
	integer :: i
	select case (eval%type)
	case (EVAL_PRODUCT)
	do i = 1, size(eval%pairing_array)
	call eval%evaluate_product (i, &
	eval%int_in1, eval%int_in2, &
	eval%pairing_array(i)%i1, eval%pairing_array(i)%i2)
	if (debug2_active (D_QFT)) then
	print *, 'eval%pairing_array(i)%i1, eval%pairing_array(i)%i2 = ', &
	eval%pairing_array(i)%i1, eval%pairing_array(i)%i2
	print *, 'MEs = ', &
	eval%int_in1%get_matrix_element (eval%pairing_array(i)%i1), &
	eval%int_in2%get_matrix_element (eval%pairing_array(i)%i2)
	end if
	end do
	case (EVAL_SQUARE_WITH_COLOR_FACTORS)
	do i = 1, size(eval%pairing_array)
	call eval%evaluate_product_cf (i, &
	eval%int_in1, eval%int_in1, &
	eval%pairing_array(i)%i1, eval%pairing_array(i)%i2, &
	eval%pairing_array(i)%factor)
	end do
	case (EVAL_SQUARED_FLOWS)
	do i = 1, size(eval%pairing_array)
	call eval%evaluate_square_c (i, &
	eval%int_in1, &
	eval%pairing_array(i)%i1)
	end do
	case (EVAL_COLOR_CONTRACTION)
	do i = 1, size(eval%pairing_array)
	call eval%evaluate_sum (i, &
	eval%int_in1, &
	eval%pairing_array(i)%i1)
	end do
	case (EVAL_IDENTITY)
	call eval%set_matrix_element (eval%int_in1)
	case (EVAL_QN_SUM)
	do i = 1, size (eval%pairing_array)
	call eval%evaluate_me_sum (i, &
	eval%int_in1, eval%pairing_array(i)%i1)
	call eval%set_norm (eval%int_in1%get_norm ())
	end do
	end select
	end subroutine evaluator_evaluate

	@ %def evaluator_evaluate
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[evaluators_ut.f90]]>>=
	<<File header>>

	module evaluators_ut
	use unit_tests
	use evaluators_uti

	<<Standard module head>>

	<<Evaluators: public test>>

	contains

	<<Evaluators: test driver>>

	end module evaluators_ut
	@ %def evaluators_ut
	@
	<<[[evaluators_uti.f90]]>>=
	<<File header>>

	module evaluators_uti

	<<Use kinds>>
	use lorentz
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use interactions
	use model_data

	use evaluators

	<<Standard module head>>

	<<Evaluators: test declarations>>

	contains

	<<Evaluators: tests>>

	end module evaluators_uti
	@ %def evaluators_ut
	@ API: driver for the unit tests below.
	<<Evaluators: public test>>=
	public :: evaluator_test
	<<Evaluators: test driver>>=
	subroutine evaluator_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Evaluators: execute tests>>
	end subroutine evaluator_test

	@ %def evaluator_test
	@ Test: Create two interactions. The interactions are twofold
	connected. The first connection has a helicity index that is kept,
	the second connection has a helicity index that is summed over.
	Concatenate the interactions in an evaluator, which thus contains a
	result interaction. Fill the input interactions with values, activate
	the evaluator and print the result.
	<<Evaluators: execute tests>>=
	call test (evaluator_1, "evaluator_1", &
	"check evaluators (1)", &
	u, results)
	<<Evaluators: test declarations>>=
	public :: evaluator_1
	<<Evaluators: tests>>=
	subroutine evaluator_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(interaction_t), target :: int_qqtt, int_tbw, int1, int2
	type(flavor_t), dimension(:), allocatable :: flv
	type(color_t), dimension(:), allocatable :: col
	type(helicity_t), dimension(:), allocatable :: hel
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: f, c, h1, h2, h3
	type(vector4_t), dimension(4) :: p
	type(vector4_t), dimension(2) :: q
	type(quantum_numbers_mask_t) :: qn_mask_conn
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask2
	type(evaluator_t), target :: eval, eval2, eval3

	call model%init_sm_test ()

	write (u, "(A)") "*** Evaluator for matrix product"
	write (u, "(A)") "*** Construct interaction for qq -> tt"
	write (u, "(A)")
	call int_qqtt%basic_init (2, 0, 2, set_relations=.true.)
	allocate (flv (4), col (4), hel (4), qn (4))
	allocate (qn_mask2 (4))
	do c = 1, 2
	select case (c)
	case (1)
	call col%init_col_acl ([1, 0, 1, 0], [0, 2, 0, 2])
	case (2)
	call col%init_col_acl ([1, 0, 2, 0], [0, 1, 0, 2])
	end select
	do f = 1, 2
	call flv%init ([f, -f, 6, -6], model)
	do h1 = -1, 1, 2
	call hel(3)%init (h1)
	do h2 = -1, 1, 2
	call hel(4)%init (h2)
	call qn%init (flv, col, hel)
	call int_qqtt%add_state (qn)
	end do
	end do
	end do
	end do
	call int_qqtt%freeze ()
	deallocate (flv, col, hel, qn)
	write (u, "(A)") "*** Construct interaction for t -> bW"
	call int_tbw%basic_init (1, 0, 2, set_relations=.true.)
	allocate (flv (3), col (3), hel (3), qn (3))
	call flv%init ([6, 5, 24], model)
	call col%init_col_acl ([1, 1, 0], [0, 0, 0])
	do h1 = -1, 1, 2
	call hel(1)%init (h1)
	do h2 = -1, 1, 2
	call hel(2)%init (h2)
	do h3 = -1, 1
	call hel(3)%init (h3)
	call qn%init (flv, col, hel)
	call int_tbw%add_state (qn)
	end do
	end do
	end do
	call int_tbw%freeze ()
	deallocate (flv, col, hel, qn)
	write (u, "(A)") "*** Link interactions"
	call int_tbw%set_source_link (1, int_qqtt, 3)
	qn_mask_conn = quantum_numbers_mask (.false.,.false.,.true.)
	write (u, "(A)")
	write (u, "(A)") "*** Show input"
	call int_qqtt%basic_write (unit = u)
	write (u, "(A)")
	call int_tbw%basic_write (unit = u)
	write (u, "(A)")
	write (u, "(A)") "*** Evaluate product"
	call eval%init_product (int_qqtt, int_tbw, qn_mask_conn)
	call eval%write (unit = u)

	call int1%basic_init (2, 0, 2, set_relations=.true.)
	call int2%basic_init (1, 0, 2, set_relations=.true.)
	p(1) = vector4_moving (1000._default, 1000._default, 3)
	p(2) = vector4_moving (200._default, 200._default, 2)
	p(3) = vector4_moving (100._default, 200._default, 1)
	p(4) = p(1) - p(2) - p(3)
	call int1%set_momenta (p)
	q(1) = vector4_moving (50._default,-50._default, 3)
	q(2) = p(2) + p(4) - q(1)
	call int2%set_momenta (q, outgoing=.true.)
	call int1%set_matrix_element ([(2._default,0._default), &
	(4._default,1._default), (-3._default,0._default)])
	call int2%set_matrix_element ([(-3._default,0._default), &
	(0._default,1._default), (1._default,2._default)])
	call eval%receive_momenta ()
	call eval%evaluate ()
	call int1%basic_write (unit = u)
	write (u, "(A)")
	call int2%basic_write (unit = u)
	write (u, "(A)")
	call eval%write (unit = u)
	write (u, "(A)")
	call int1%final ()
	call int2%final ()
	call eval%final ()

	write (u, "(A)")
	write (u, "(A)") "*** Evaluator for matrix square"
	allocate (flv(4), col(4), qn(4))
	call int1%basic_init (2, 0, 2, set_relations=.true.)
	call flv%init ([1, -1, 21, 21], model)
	call col(1)%init ([1])
	call col(2)%init ([-2])
	call col(3)%init ([2, -3])
	call col(4)%init ([3, -1])
	call qn%init (flv, col)
	call int1%add_state (qn)
	call col(3)%init ([3, -1])
	call col(4)%init ([2, -3])
	call qn%init (flv, col)
	call int1%add_state (qn)
	call col(3)%init ([2, -1])
	call col(4)%init (.true.)
	call qn%init (flv, col)
	call int1%add_state (qn)
	call int1%freeze ()
	! [qn_mask2 not set since default is false]
	call eval%init_square (int1, qn_mask2, nc=3)
	call eval2%init_square_nondiag (int1, qn_mask2)
	qn_mask2 = quantum_numbers_mask (.false., .true., .true.)
	call eval3%init_square_diag (eval, qn_mask2)
	call int1%set_matrix_element &
	([(2._default,0._default), &
	(4._default,1._default), (-3._default,0._default)])
	call int1%set_momenta (p)
	call int1%basic_write (unit = u)
	write (u, "(A)")
	call eval%receive_momenta ()
	call eval%evaluate ()
	call eval%write (unit = u)
	write (u, "(A)")
	call eval2%receive_momenta ()
	call eval2%evaluate ()
	call eval2%write (unit = u)
	write (u, "(A)")
	call eval3%receive_momenta ()
	call eval3%evaluate ()
	call eval3%write (unit = u)
	call int1%final ()
	call eval%final ()
	call eval2%final ()
	call eval3%final ()

	call model%final ()
	end subroutine evaluator_1

	@ %def evaluator_1
	@
	<<Evaluators: execute tests>>=
	call test (evaluator_2, "evaluator_2", &
	"check evaluators (2)", &
	u, results)
	<<Evaluators: test declarations>>=
	public :: evaluator_2
	<<Evaluators: tests>>=
	subroutine evaluator_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(interaction_t), target :: int
	integer :: h1, h2, h3, h4
	type(helicity_t), dimension(4) :: hel
	type(color_t), dimension(4) :: col
	type(flavor_t), dimension(4) :: flv
	type(quantum_numbers_t), dimension(4) :: qn
	type(vector4_t), dimension(4) :: p
	type(evaluator_t) :: eval
	integer :: i

	call model%init_sm_test ()

	write (u, "(A)") "*** Creating interaction for e+ e- -> W+ W-"
	write (u, "(A)")

	call flv%init ([11, -11, 24, -24], model)
	do i = 1, 4
	call col(i)%init ()
	end do
	call int%basic_init (2, 0, 2, set_relations=.true.)
	do h1 = -1, 1, 2
	call hel(1)%init (h1)
	do h2 = -1, 1, 2
	call hel(2)%init (h2)
	do h3 = -1, 1
	call hel(3)%init (h3)
	do h4 = -1, 1
	call hel(4)%init (h4)
	call qn%init (flv, col, hel)
	call int%add_state (qn)
	end do
	end do
	end do
	end do
	call int%freeze ()
	call int%set_matrix_element &
	([(cmplx (i, kind=default), i = 1, 36)])
	p(1) = vector4_moving (1000._default, 1000._default, 3)
	p(2) = vector4_moving (1000._default, -1000._default, 3)
	p(3) = vector4_moving (1000._default, &
	sqrt (1E6_default - 80._default**2), 3)
	p(4) = p(1) + p(2) - p(3)
	call int%set_momenta (p)
	write (u, "(A)") "*** Setting up evaluator"
	write (u, "(A)")

	call eval%init_identity (int)
	write (u, "(A)") "*** Transferring momenta and evaluating"
	write (u, "(A)")

	call eval%receive_momenta ()
	call eval%evaluate ()
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Interaction dump"
	write (u, "(A)") "*******************************************************"
	call int%basic_write (unit = u)
	write (u, "(A)")
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Evaluator dump"
	write (u, "(A)") "*******************************************************"
	call eval%write (unit = u)
	write (u, "(A)")
	write (u, "(A)") "*** cleaning up"
	call int%final ()
	call eval%final ()

	call model%final ()
	end subroutine evaluator_2

	@ %def evaluator_2
	@
	<<Evaluators: execute tests>>=
	call test (evaluator_3, "evaluator_3", &
	"check evaluators (3)", &
	u, results)
	<<Evaluators: test declarations>>=
	public :: evaluator_3
	<<Evaluators: tests>>=
	subroutine evaluator_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(interaction_t), target :: int
	integer :: h1, h2, h3, h4
	type(helicity_t), dimension(4) :: hel
	type(color_t), dimension(4) :: col
	type(flavor_t), dimension(4) :: flv1, flv2
	type(quantum_numbers_t), dimension(4) :: qn
	type(vector4_t), dimension(4) :: p
	type(evaluator_t) :: eval1, eval2, eval3
	type(quantum_numbers_mask_t), dimension(4) :: qn_mask
	integer :: i

	call model%init_sm_test ()

	write (u, "(A)") "*** Creating interaction for e+/mu+ e-/mu- -> W+ W-"
	call flv1%init ([11, -11, 24, -24], model)
	call flv2%init ([13, -13, 24, -24], model)
	do i = 1, 4
	call col (i)%init ()
	end do
	call int%basic_init (2, 0, 2, set_relations=.true.)
	do h1 = -1, 1, 2
	call hel(1)%init (h1)
	do h2 = -1, 1, 2
	call hel(2)%init (h2)
	do h3 = -1, 1
	call hel(3)%init (h3)
	do h4 = -1, 1
	call hel(4)%init (h4)
	call qn%init (flv1, col, hel)
	call int%add_state (qn)
	call qn%init (flv2, col, hel)
	call int%add_state (qn)
	end do
	end do
	end do
	end do
	call int%freeze ()
	call int%set_matrix_element &
	([(cmplx (1, kind=default), i = 1, 72)])
	p(1) = vector4_moving (1000._default, 1000._default, 3)
	p(2) = vector4_moving (1000._default, -1000._default, 3)
	p(3) = vector4_moving (1000._default, &
	sqrt (1E6_default - 80._default**2), 3)
	p(4) = p(1) + p(2) - p(3)
	call int%set_momenta (p)
	write (u, "(A)") "*** Setting up evaluators"
	call qn_mask%init (.false., .true., .true.)
	call eval1%init_qn_sum (int, qn_mask)
	call qn_mask%init (.true., .true., .true.)
	call eval2%init_qn_sum (int, qn_mask)
	call qn_mask%init (.false., .true., .false.)
	call eval3%init_qn_sum (int, qn_mask, &
	[.false., .false., .false., .true.])
	write (u, "(A)") "*** Transferring momenta and evaluating"
	call eval1%receive_momenta ()
	call eval1%evaluate ()
	call eval2%receive_momenta ()
	call eval2%evaluate ()
	call eval3%receive_momenta ()
	call eval3%evaluate ()
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Interaction dump"
	write (u, "(A)") "*******************************************************"
	call int%basic_write (unit = u)
	write (u, "(A)")
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Evaluator dump --- spin sum"
	write (u, "(A)") "*******************************************************"
	call eval1%write (unit = u)
	call eval1%basic_write (unit = u)
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Evaluator dump --- spin / flavor sum"
	write (u, "(A)") "*******************************************************"
	call eval2%write (unit = u)
	call eval2%basic_write (unit = u)
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Evaluator dump --- flavor sum, drop last W"
	write (u, "(A)") "*******************************************************"
	call eval3%write (unit = u)
	call eval3%basic_write (unit = u)
	write (u, "(A)")
	write (u, "(A)") "*** cleaning up"
	call int%final ()
	call eval1%final ()
	call eval2%final ()
	call eval3%final ()

	call model%final ()
	end subroutine evaluator_3

	@ %def evaluator_3
	@ This test evaluates a product with different quantum-number masks and
	filters for the linked entry.
	<<Evaluators: execute tests>>=
	call test (evaluator_4, "evaluator_4", &
	"check evaluator product with filter", &
	u, results)
	<<Evaluators: test declarations>>=
	public :: evaluator_4
	<<Evaluators: tests>>=
	subroutine evaluator_4 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(interaction_t), target :: int1, int2
	integer :: h1, h2, h3
	type(helicity_t), dimension(3) :: hel
	type(color_t), dimension(3) :: col
	type(flavor_t), dimension(2) :: flv1, flv2
	type(flavor_t), dimension(3) :: flv3, flv4
	type(quantum_numbers_t), dimension(3) :: qn
	type(evaluator_t) :: eval1, eval2, eval3, eval4
	type(quantum_numbers_mask_t) :: qn_mask
	type(flavor_t) :: flv_filter
	type(helicity_t) :: hel_filter
	type(color_t) :: col_filter
	type(quantum_numbers_t) :: qn_filter
	integer :: i

	write (u, "(A)") "* Test output: evaluator_4"
	write (u, "(A)") "* Purpose: test evaluator products &
	&with mask and filter"
	write (u, "(A)")

	call model%init_sm_test ()

	write (u, "(A)") "* Creating interaction for e- -> W+/Z"
	write (u, "(A)")

	call flv1%init ([11, 24], model)
	call flv2%init ([11, 23], model)
	do i = 1, 3
	call col(i)%init ()
	end do
	call int1%basic_init (1, 0, 1, set_relations=.true.)
	do h1 = -1, 1, 2
	call hel(1)%init (h1)
	do h2 = -1, 1
	call hel(2)%init (h2)
	call qn(:2)%init (flv1, col(:2), hel(:2))
	call int1%add_state (qn(:2))
	call qn(:2)%init (flv2, col(:2), hel(:2))
	call int1%add_state (qn(:2))
	end do
	end do
	call int1%freeze ()
	call int1%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Creating interaction for W+/Z -> u ubar/dbar"
	write (u, "(A)")

	call flv3%init ([24, 2, -1], model)
	call flv4%init ([23, 2, -2], model)

	call int2%basic_init (1, 0, 2, set_relations=.true.)
	do h1 = -1, 1
	call hel(1)%init (h1)
	do h2 = -1, 1, 2
	call hel(2)%init (h2)
	do h3 = -1, 1, 2
	call hel(3)%init (h3)
	call qn(:3)%init (flv3, col(:3), hel(:3))
	call int2%add_state (qn(:3))
	call qn(:3)%init (flv4, col(:3), hel(:3))
	call int2%add_state (qn(:3))
	end do
	end do
	end do
	call int2%freeze ()

	call int2%set_source_link (1, int1, 2)
	call int2%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Product evaluator"
	write (u, "(A)")

	call qn_mask%init (.false., .false., .false.)
	call eval1%init_product (int1, int2, qn_mask_conn = qn_mask)
	call eval1%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Product evaluator with helicity mask"
	write (u, "(A)")

	call qn_mask%init (.false., .false., .true.)
	call eval2%init_product (int1, int2, qn_mask_conn = qn_mask)
	call eval2%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Product with flavor filter and helicity mask"
	write (u, "(A)")

	call qn_mask%init (.false., .false., .true.)
	call flv_filter%init (24, model)
	call hel_filter%init ()
	call col_filter%init ()
	call qn_filter%init (flv_filter, col_filter, hel_filter)
	call eval3%init_product (int1, int2, &
	qn_mask_conn = qn_mask, qn_filter_conn = qn_filter)
	call eval3%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Product with helicity filter and mask"
	write (u, "(A)")

	call qn_mask%init (.false., .false., .true.)
	call flv_filter%init ()
	call hel_filter%init (0)
	call col_filter%init ()
	call qn_filter%init (flv_filter, col_filter, hel_filter)
	call eval4%init_product (int1, int2, &
	qn_mask_conn = qn_mask, qn_filter_conn = qn_filter)
	call eval4%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call eval1%final ()
	call eval2%final ()
	call eval3%final ()
	call eval4%final ()

	call int1%final ()
	call int2%final ()

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: evaluator_4"

	end subroutine evaluator_4

	@ %def evaluator_4
	Index: trunk/src/noweb-frame/whizard-prelude.nw
	===================================================================
	--- trunk/src/noweb-frame/whizard-prelude.nw (revision 8903)
	+++ trunk/src/noweb-frame/whizard-prelude.nw (revision 8904)
	@@ -1,176 +1,177 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: Header, intro and generic stuff

	\documentclass[a4paper]{report}

	\usepackage{amsmath,amssymb,dsfont}

	\usepackage
	[bookmarks,bookmarksopen=true,bookmarksopenlevel=1,bookmarksnumbered=true]
	{hyperref}

	\usepackage{noweb}
	\usepackage{graphics,graphicx}
	\usepackage{url}
	\usepackage[T1]{fontenc}
	\setlength{\nwmarginglue}{1em}
	\noweboptions{smallcode,noidentxref}
	%%% Saving paper:
	\def\nwendcode{\endtrivlist\endgroup}
	\nwcodepenalty=0
	\let\nwdocspar\relax

	%\makeindex

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%% Macros

	\def\tsum{{\textstyle\sum}}

	\newcommand{\circeone}{\texttt{CIRCE1}}
	\newcommand{\circetwo}{\texttt{CIRCE2}}
	\newcommand{\whizard}{\texttt{WHIZARD}}
	% Noweb emacs mode: single ' below
	\newcommand{\oMega}{\texttt{O'MEGA}}
	\newcommand{\vamp}{\texttt{VAMP}}
	\newcommand{\vamptwo}{\texttt{VAMP2}}
	\newcommand{\pythia}{\texttt{PYTHIA}}
	\newcommand{\gosam}{\texttt{GoSam}}
	\newcommand{\includemodulegraph}{\begingroup
	\catcode`_=12 \doincludemodulegraph}
	\newcommand{\doincludemodulegraph}[1]{%
	\begin{figure}
	\includegraphics[width=\textwidth]{#1}%
	\caption{Module dependencies in \texttt{src/#1}.}
	\end{figure}
	\endgroup
	}

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\begin{document}
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\def\WhizardVersion{3.1.3.1}
	\def\WhizardDate{Oct 06 2023}
	<<Version>>=
	3.1.3.1
	<<Date>>=
	Oct 06 2023
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\title{%
	\whizard\footnote{The original meaning of the acronym is \emph{$W$,
	Higgs, $Z$, And Respective Decays}. The current program is much more
	than that, however.}
	}
	\author{%
	Wolfgang Kilian,%
	\thanks{e-mail: \texttt{kilian@physik.uni-siegen.de}}
	Thorsten Ohl,%
	\thanks{e-mail: \texttt{ohl@physik.uni-wuerzburg.de}}
	J\"urgen Reuter%
	\thanks{e-mail: \texttt{juergen.reuter@desy.de}}}
	\date{Version \WhizardVersion, \WhizardDate \\
	\mbox{}
	with contributions from:
	Fabian Bach, Tim Barklow, Vincent Bettaque, Mikael Berggren,
	Hans-Werner Boschmann, Felix Braam, Simon Brass, Pia Bredt,
	Bijan Chokouf\'{e} Nejad, Oliver Fischer, Christian Fleper,
	- David Gordo Gomez, Uta Klein, Nils Kreher, Krzysztof~M\k{e}ka{\l}a,
	- Akiya Miyamoto, Moritz Prei{\ss}er, Vincent Rothe, Sebastian Schmidt,
	- Marco Sekulla, So Young Shim, Christian Speckner, Pascal Stienemeier,
	- Tobias Striegl, Manuel Utsch, Christian Weiss, Daniel Wiesler,
	+ David Gordo Gomez, Marius H\"ofer, Uta Klein, Nils Kreher,
	+ Krzysztof~M\k{e}ka{\l}a, Akiya Miyamoto, Moritz Prei{\ss}er,
	+ Vincent Rothe, Sebastian Schmidt, Marco Sekulla, So Young Shim,
	+ Christian Speckner, Pascal Stienemeier, Tobias Striegl,
	+ Manuel Utsch, Christian Weiss, Daniel Wiesler,
	Aleksander Filip \.Zarnecki, Zhijie Zhao
	\vspace{1cm}
	\begin{center}
	\includegraphics[width=4cm]{Whizard-Logo}
	\end{center}
	\mbox{} \\
	\vspace{.2cm}}
	\maketitle


	\begin{abstract}
	\texttt{WHIZARD} is an application of the \texttt{VAMP} algorithm:
	Adaptive multi-channel integration and event generation. The bare
	\texttt{VAMP} library is augmented by modules for Lorentz algebra,
	particles, phase space, etc., such that physical processes with
	arbitrary complex final states [well, in principle\ldots] can be
	integrated and \emph{unweighted} events be generated.
	\end{abstract}


	\newpage

	\begin{figure}
	\centering
	\includegraphics[angle=90,width=\textwidth,height=\textheight,keepaspectratio]{overview}
	\caption{Overall folder structure}
	\end{figure}

	\newpage

	\tableofcontents

	\newpage

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Changes}

	{\bf For a comprehensive list of changes confer the
	ChangeLog file or the subversion log.}

	\chapter{Preliminaries}
	The WHIZARD file header:
	<<File header>>=
	! WHIZARD <<Version>> <<Date>>
	!
	! Copyright (C) 1999-2023 by
	! Wolfgang Kilian <kilian@physik.uni-siegen.de>
	! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	! Juergen Reuter <juergen.reuter@desy.de>
	!
	! with contributions from
	! cf. main AUTHORS 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.
	!
	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	! This file has been stripped of most comments. For documentation, refer
	! to the source 'whizard.nw'
	@
	We are strict with our names:
	<<Standard module head>>=
	implicit none
	private
	@ This is the way to envoke the kinds module (not contained in this source)
	<<Use kinds>>=
	use kinds, only: default
	<<Use kinds with double>>=
	use kinds, only: default, double
	@ %def default
	@ And we make heavy use of variable-length strings
	<<Use strings>>=
	use iso_varying_string, string_t => varying_string
	@ %def string_t
	@ Access to the [[debug_on]] master switch
	<<Use debug>>=
	use debug_master, only: debug_on
	@ %def debug_on
	@ And we need the Fortran 2008 MPI module, if compiled with [[MPI]].
	<<Use mpi f08>>=
	@
	<<MPI: Use mpi f08>>=
	use mpi_f08 !NODEP!
	@ %def mpi_f08
	Index: trunk/src/gosam/gosam.nw
	===================================================================
	--- trunk/src/gosam/gosam.nw (revision 8903)
	+++ trunk/src/gosam/gosam.nw (revision 8904)
	@@ -1,994 +1,1090 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: GoSam interface
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{GoSam Interface}
	\includemodulegraph{gosam}

	The code in this chapter makes amplitudes accessible to \whizard\ that
	are generated and computed by the GoSam package.

	These are the modules:
	\begin{description}
	\item[loop\_archive]
	Provide some useful extra functionality.
	\item[prc\_gosam]
	The actual interface, following the \whizard\ conventions for
	matrix-element generator methods.
	\end{description}

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Gosam Interface}
	<<[[prc_gosam.f90]]>>=
	<<File header>>

	module prc_gosam

	use, intrinsic :: iso_c_binding !NODEP!
	use, intrinsic :: iso_fortran_env

	use kinds
	<<Use strings>>
	use physics_defs
	use os_interface
	use lorentz
	use interactions
	use model_data
	use variables
	use prc_core_def
	use prc_core
	use blha_config
	use blha_olp_interfaces

	<<Standard module head>>

	<<Prc gosam: constants>>

	<<Prc gosam: public>>

	+<<Prc gosam: main parameters>>
	+
	<<Prc gosam: types>>

	<<Prc gosam: interfaces>>

	interface
	<<Prc gosam: sub interfaces>>
	end interface

	contains

	<<Prc gosam: main procedures>>

	end module prc_gosam

	@
	@ %def module prc_gosam
	@
	<<[[prc_gosam_sub.f90]]>>=
	<<File header>>

	submodule (prc_gosam) prc_gosam_s

	+<<Use debug>>
	use io_units
	use constants
	use numeric_utils
	use system_defs, only: TAB
	use system_dependencies
	use file_utils
	use string_utils
	use diagnostics
	use sm_qcd
	use flavors
	use pdg_arrays
	use process_constants
	use prclib_interfaces
	use process_libraries

	implicit none

	contains

	<<Prc gosam: procedures>>

	end submodule prc_gosam_s

	@ %def prc_gosam_s
	@
	<<Prc gosam: types>>=
	type, extends (prc_blha_writer_t) :: gosam_writer_t
	type(string_t) :: gosam_dir
	type(string_t) :: golem_dir
	type(string_t) :: samurai_dir
	type(string_t) :: ninja_dir
	type(string_t) :: form_dir
	type(string_t) :: qgraf_dir
	type(string_t) :: filter_lo, filter_nlo
	type(string_t) :: symmetries
	integer :: form_threads
	integer :: form_workspace
	type(string_t) :: fc
	contains
	<<Prc gosam: gosam writer: TBP>>
	end type gosam_writer_t

	-@
	@ %def gosam_writer_t
	-
	+@
	<<Prc gosam: public>>=
	public :: gosam_def_t
	<<Prc gosam: types>>=
	type, extends (blha_def_t) :: gosam_def_t
	logical :: execute_olp = .true.
	contains
	<<Prc gosam: gosam def: TBP>>
	end type gosam_def_t

	@
	@ %def gosam_def_t
	<<Prc gosam: types>>=
	type, extends (blha_driver_t) :: gosam_driver_t
	type(string_t) :: gosam_dir
	type(string_t) :: olp_file
	type(string_t) :: olc_file
	type(string_t) :: olp_dir
	type(string_t) :: olp_lib
	contains
	<<Prc gosam: gosam driver: TBP>>
	end type gosam_driver_t

	@
	@ %def gosam_driver_t
	<<Prc gosam: public>>=
	public :: prc_gosam_t
	<<Prc gosam: types>>=
	type, extends (prc_blha_t) :: prc_gosam_t
	logical :: initialized = .false.
	contains
	<<Prc gosam: prc gosam: TBP>>
	end type prc_gosam_t

	@
	@ %def prc_gosam_t
	<<Prc gosam: types>>=
	type, extends (blha_state_t) :: gosam_state_t
	contains
	<<Prc gosam: gosam state: TBP>>
	end type gosam_state_t

	@ %def gosam_state_t
	@ Gfortran 7/8/9 bug: has to remain in main module.
	<<Prc gosam: gosam def: TBP>>=
	procedure :: init => gosam_def_init
	<<Prc gosam: main procedures>>=
	subroutine gosam_def_init (object, basename, model_name, &
	- prt_in, prt_out, nlo_type, restrictions, var_list)
	+ prt_in, prt_out, nlo_type, ufo, ufo_path, restrictions, var_list)
	class(gosam_def_t), intent(inout) :: object
	type(string_t), intent(in) :: basename
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in, prt_out
	integer, intent(in) :: nlo_type
	+ logical, intent(in), optional :: ufo
	+ type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	type(var_list_t), intent(in) :: var_list
	object%basename = basename
	allocate (gosam_writer_t :: object%writer)
	select case (nlo_type)
	case (BORN)
	object%suffix = '_BORN'
	case (NLO_REAL)
	object%suffix = '_REAL'
	case (NLO_VIRTUAL)
	object%suffix = '_LOOP'
	- case (NLO_SUBTRACTION)
	+ case (NLO_SUBTRACTION, NLO_MISMATCH)
	object%suffix = '_SUB'
	+ case (NLO_DGLAP)
	+ object%suffix = "_DGLAP"
	end select
	select type (writer => object%writer)
	type is (gosam_writer_t)
	- call writer%init (model_name, prt_in, prt_out, restrictions)
	+ call writer%init (model_name, prt_in, prt_out, ufo, ufo_path, restrictions)
	writer%filter_lo = var_list%get_sval (var_str ("$gosam_filter_lo"))
	writer%filter_nlo = var_list%get_sval (var_str ("$gosam_filter_nlo"))
	writer%symmetries = &
	var_list%get_sval (var_str ("$gosam_symmetries"))
	writer%form_threads = &
	var_list%get_ival (var_str ("form_threads"))
	writer%form_workspace = &
	var_list%get_ival (var_str ("form_workspace"))
	writer%fc = &
	var_list%get_sval (var_str ("$gosam_fc"))
	end select
	end subroutine gosam_def_init

	@ %def gosam_def_init
	@
	<<Prc gosam: gosam writer: TBP>>=
	procedure :: write_config => gosam_writer_write_config
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_writer_write_config (gosam_writer)
	class(gosam_writer_t), intent(in) :: gosam_writer
	end subroutine gosam_writer_write_config
	<<Prc gosam: procedures>>=
	module subroutine gosam_writer_write_config (gosam_writer)
	class(gosam_writer_t), intent(in) :: gosam_writer
	integer :: unit
	unit = free_unit ()
	open (unit, file = "golem.in", status = "replace", action = "write")
	call gosam_writer%generate_configuration_file (unit)
	close(unit)
	end subroutine gosam_writer_write_config

	@ %def gosam_writer_write_config
	@
	<<Prc gosam: gosam def: TBP>>=
	procedure, nopass :: type_string => gosam_def_type_string
	<<Prc gosam: sub interfaces>>=
	module function gosam_def_type_string () result (string)
	type(string_t) :: string
	end function gosam_def_type_string
	<<Prc gosam: procedures>>=
	module function gosam_def_type_string () result (string)
	type(string_t) :: string
	string = "gosam"
	end function gosam_def_type_string

	-@
	@ %def gosam_def_type_string
	+@
	<<Prc gosam: gosam def: TBP>>=
	procedure :: write => gosam_def_write
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_def_write (object, unit)
	class(gosam_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine gosam_def_write
	<<Prc gosam: procedures>>=
	module subroutine gosam_def_write (object, unit)
	class(gosam_def_t), intent(in) :: object
	integer, intent(in) :: unit
	select type (writer => object%writer)
	type is (gosam_writer_t)
	call writer%write (unit)
	end select
	end subroutine gosam_def_write

	@
	@ %def gosam_def_write
	<<Prc gosam: gosam def: TBP>>=
	procedure :: read => gosam_def_read
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_def_read (object, unit)
	class(gosam_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine gosam_def_read
	<<Prc gosam: procedures>>=
	module subroutine gosam_def_read (object, unit)
	class(gosam_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine gosam_def_read

	@ %def gosam_def_read
	@ Gfortran 7/8/9 bug: has to remain in main module.
	<<Prc gosam: gosam def: TBP>>=
	procedure :: allocate_driver => gosam_def_allocate_driver
	<<Prc gosam: main procedures>>=
	subroutine gosam_def_allocate_driver (object, driver, basename)
	class(gosam_def_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	if (.not. allocated (driver)) allocate (gosam_driver_t :: driver)
	end subroutine gosam_def_allocate_driver

	@
	@ %def gosam_def_allocate_driver
	<<Prc gosam: gosam writer: TBP>>=
	procedure, nopass :: type_name => gosam_writer_type_name
	<<Prc gosam: sub interfaces>>=
	module function gosam_writer_type_name () result (string)
	type(string_t) :: string
	end function gosam_writer_type_name
	<<Prc gosam: procedures>>=
	module function gosam_writer_type_name () result (string)
	type(string_t) :: string
	string = "gosam"
	end function gosam_writer_type_name

	@
	@ %def gosam_writer_type_name
	<<Prc gosam: gosam writer: TBP>>=
	procedure :: init => gosam_writer_init
	<<Prc gosam: sub interfaces>>=
	pure module subroutine gosam_writer_init &
	- (writer, model_name, prt_in, prt_out, restrictions)
	+ (writer, model_name, prt_in, prt_out, ufo, ufo_path, restrictions)
	class(gosam_writer_t), intent(inout) :: writer
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in, prt_out
	+ logical, intent(in), optional :: ufo
	+ type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	end subroutine gosam_writer_init
	<<Prc gosam: procedures>>=
	pure module subroutine gosam_writer_init &
	- (writer, model_name, prt_in, prt_out, restrictions)
	+ (writer, model_name, prt_in, prt_out, ufo, ufo_path, restrictions)
	class(gosam_writer_t), intent(inout) :: writer
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in, prt_out
	+ logical, intent(in), optional :: ufo
	+ type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	writer%gosam_dir = GOSAM_DIR
	writer%golem_dir = GOLEM_DIR
	writer%samurai_dir = SAMURAI_DIR
	writer%ninja_dir = NINJA_DIR
	writer%form_dir = FORM_DIR
	writer%qgraf_dir = QGRAF_DIR
	- call writer%base_init (model_name, prt_in, prt_out)
	+ call writer%base_init (model_name, prt_in, prt_out, ufo, ufo_path)
	end subroutine gosam_writer_init

	@ %def gosam_writer_init
	@
	<<Prc gosam: gosam driver: TBP>>=
	procedure, nopass :: type_name => gosam_driver_type_name
	<<Prc gosam: sub interfaces>>=
	module function gosam_driver_type_name () result (string)
	type(string_t) :: string
	end function gosam_driver_type_name
	<<Prc gosam: procedures>>=
	module function gosam_driver_type_name () result (string)
	type(string_t) :: string
	string = "gosam"
	end function gosam_driver_type_name

	@ %def gosam_driver_type_name
	@
	<<Prc gosam: gosam driver: TBP>>=
	procedure :: init_gosam => gosam_driver_init_gosam
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_driver_init_gosam (object, os_data, olp_file, &
	olc_file, olp_dir, olp_lib)
	class(gosam_driver_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: olp_file, olc_file, olp_dir, olp_lib
	end subroutine gosam_driver_init_gosam
	<<Prc gosam: procedures>>=
	module subroutine gosam_driver_init_gosam (object, os_data, olp_file, &
	olc_file, olp_dir, olp_lib)
	class(gosam_driver_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: olp_file, olc_file, olp_dir, olp_lib
	object%gosam_dir = GOSAM_DIR
	object%olp_file = olp_file
	object%contract_file = olc_file
	object%olp_dir = olp_dir
	object%olp_lib = olp_lib
	end subroutine gosam_driver_init_gosam

	@ %def gosam_driver_init
	@
	<<Prc gosam: gosam driver: TBP>>=
	procedure :: init_dlaccess_to_library => gosam_driver_init_dlaccess_to_library
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_driver_init_dlaccess_to_library &
	(object, os_data, dlaccess, success)
	class(gosam_driver_t), intent(in) :: object
	type(os_data_t), intent(in) :: os_data
	type(dlaccess_t), intent(out) :: dlaccess
	logical, intent(out) :: success
	end subroutine gosam_driver_init_dlaccess_to_library
	<<Prc gosam: procedures>>=
	module subroutine gosam_driver_init_dlaccess_to_library &
	(object, os_data, dlaccess, success)
	class(gosam_driver_t), intent(in) :: object
	type(os_data_t), intent(in) :: os_data
	type(dlaccess_t), intent(out) :: dlaccess
	logical, intent(out) :: success
	type(string_t) :: libname, msg_buffer
	libname = object%olp_dir // '/.libs/libgolem_olp.' // &
	os_data%shrlib_ext
	msg_buffer = "One-Loop-Provider: Using Gosam"
	call msg_message (char(msg_buffer))
	msg_buffer = "Loading library: " // libname
	call msg_message (char(msg_buffer))
	call dlaccess_init (dlaccess, var_str ("."), libname, os_data)
	success = .not. dlaccess_has_error (dlaccess)
	end subroutine gosam_driver_init_dlaccess_to_library

	@ %def gosam_driver_init_dlaccess_to_library
	@
	<<Prc gosam: gosam writer: TBP>>=
	procedure :: generate_configuration_file => &
	gosam_writer_generate_configuration_file
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_writer_generate_configuration_file &
	(object, unit)
	class(gosam_writer_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine gosam_writer_generate_configuration_file
	<<Prc gosam: procedures>>=
	module subroutine gosam_writer_generate_configuration_file &
	(object, unit)
	class(gosam_writer_t), intent(in) :: object
	integer, intent(in) :: unit
	type(string_t) :: fc_bin
	type(string_t) :: form_bin, qgraf_bin, haggies_bin
	type(string_t) :: fcflags_golem, ldflags_golem
	type(string_t) :: fcflags_samurai, ldflags_samurai
	type(string_t) :: fcflags_ninja, ldflags_ninja
	type(string_t) :: ldflags_avh_olo, ldflags_qcdloop
	fc_bin = DEFAULT_FC
	form_bin = object%form_dir // '/bin/tform'
	qgraf_bin = object%qgraf_dir // '/bin/qgraf'
	if (object%gosam_dir /= "") then
	haggies_bin = '/usr/bin/java -jar ' // object%gosam_dir // &
	'/share/golem/haggies/haggies.jar'
	else
	call msg_fatal ("generate_configuration_file: At least " // &
	"the GoSam Directory has to be specified!")
	end if
	if (object%golem_dir /= "") then
	fcflags_golem = "-I" // object%golem_dir // "/include/golem95"
	ldflags_golem = "-L" // object%golem_dir // "/lib -lgolem"
	end if
	if (object%samurai_dir /= "") then
	fcflags_samurai = "-I" // object%samurai_dir // "/include/samurai"
	ldflags_samurai = "-L" // object%samurai_dir // "/lib -lsamurai"
	ldflags_avh_olo = "-L" // object%samurai_dir // "/lib -lavh_olo"
	ldflags_qcdloop = "-L" // object%samurai_dir // "/lib -lqcdloop"
	end if
	if (object%ninja_dir /= "") then
	fcflags_ninja = "-I" // object%ninja_dir // "/include/ninja " &
	// "-I" // object%ninja_dir // "/include"
	ldflags_ninja = "-L" // object%ninja_dir // "/lib -lninja"
	end if
	write (unit, "(A)") "#+avh_olo.ldflags=" &
	// char (ldflags_avh_olo)
	write (unit, "(A)") "reduction_programs=golem95, samurai, ninja"
	write (unit, "(A)") "extensions=autotools"
	write (unit, "(A)") "#+qcdloop.ldflags=" &
	// char (ldflags_qcdloop)
	write (unit, "(A)") "#+zzz.extensions=qcdloop, avh_olo"
	write (unit, "(A)") "#fc.bin=" // char (fc_bin)
	write (unit, "(A)") "form.bin=" // char (form_bin)
	write (unit, "(A)") "qgraf.bin=" // char (qgraf_bin)
	write (unit, "(A)") "#golem95.fcflags=" // char (fcflags_golem)
	write (unit, "(A)") "#golem95.ldflags=" // char (ldflags_golem)
	write (unit, "(A)") "haggies.bin=" // char (haggies_bin)
	write (unit, "(A)") "#samurai.fcflags=" // char (fcflags_samurai)
	write (unit, "(A)") "#samurai.ldflags=" // char (ldflags_samurai)
	write (unit, "(A)") "#ninja.fcflags=" // char (fcflags_ninja)
	write (unit, "(A)") "#ninja.ldflags=" // char (ldflags_ninja)
	!!! This might collide with the mass-setup in the order-file
	!!! write (unit, "(A)") "zero=mU,mD,mC,mS,mB"
	!!! This is covered by the BLHA2 interface
	write (unit, "(A)") "PSP_check=False"
	- if (char (object%filter_lo) /= "") &
	- write (unit, "(A)") "filter.lo=" // char (object%filter_lo)
	- if (char (object%filter_nlo) /= "") &
	- write (unit, "(A)") "filter.nlo=" // char (object%filter_nlo)
	- if (char (object%symmetries) /= "") &
	- write (unit, "(A)") "symmetries=" // char(object%symmetries)
	- write (unit, "(A,I0)") "form.threads=", object%form_threads
	- write (unit, "(A,I0)") "form.workspace=", object%form_workspace
	- if (char (object%fc) /= "") &
	- write (unit, "(A)") "fc.bin=" // char(object%fc)
	+ write (unit, "(A)") "all_mandelstam=True"
	+ if (char (object%filter_lo) /= "") &
	+ write (unit, "(A)") "filter.lo=" // char (object%filter_lo)
	+ if (char (object%filter_nlo) /= "") &
	+ write (unit, "(A)") "filter.nlo=" // char (object%filter_nlo)
	+ if (char (object%symmetries) /= "") &
	+ write (unit, "(A)") "symmetries=" // char(object%symmetries)
	+ write (unit, "(A,I0)") "form.threads=", object%form_threads
	+ write (unit, "(A,I0)") "form.workspace=", object%form_workspace
	+ if (char (object%fc) /= "") &
	+ write (unit, "(A)") "fc.bin=" // char(object%fc)
	end subroutine gosam_writer_generate_configuration_file

	@ %def gosam_writer_generate_configuration_file
	@ We have to assure that all files necessary for the configure process
	in the GoSam code are ready. This is done with a stamp mechanism.
	<<Prc gosam: gosam driver: TBP>>=
	procedure :: write_makefile => gosam_driver_write_makefile
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_driver_write_makefile (object, unit, libname)
	class(gosam_driver_t), intent(in) :: object
	integer, intent(in) :: unit
	type(string_t), intent(in) :: libname
	end subroutine gosam_driver_write_makefile
	<<Prc gosam: procedures>>=
	module subroutine gosam_driver_write_makefile (object, unit, libname)
	class(gosam_driver_t), intent(in) :: object
	integer, intent(in) :: unit
	type(string_t), intent(in) :: libname
	write (unit, "(2A)") "OLP_FILE = ", char (object%olp_file)
	write (unit, "(2A)") "OLP_DIR = ", char (object%olp_dir)
	write (unit, "(A)")
	- write (unit, "(A)") "all: $(OLP_DIR)/config.log"
	- write (unit, "(2A)") TAB, "make -C $(OLP_DIR) install"
	+ write (unit, "(A)") "all: $(OLP_DIR)/.libs/libgolem_olp.so"
	write (unit, "(A)")
	- write (unit, "(3A)") "$(OLP_DIR)/config.log: "
	+ write (unit, "(3A)") "$(OLP_DIR)/.libs/libgolem_olp.so: "
	write (unit, "(4A)") TAB, char (object%gosam_dir // "/bin/gosam.py "), &
	"--olp $(OLP_FILE) --destination=$(OLP_DIR)", &
	" -f -z"
	write (unit, "(3A)") TAB, "cd $(OLP_DIR); ./autogen.sh --prefix=", &
	- "$(dir $(abspath $(lastword $(MAKEFILE_LIST))))"
	+ "$(dir $(abspath $(lastword $(MAKEFILE_LIST)))); make install"
	end subroutine gosam_driver_write_makefile
	@ %def gosam_driver_write_makefile
	@
	<<Prc gosam: gosam driver: TBP>>=
	procedure :: set_alpha_s => gosam_driver_set_alpha_s
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_driver_set_alpha_s (driver, alpha_s)
	class(gosam_driver_t), intent(in) :: driver
	real(default), intent(in) :: alpha_s
	end subroutine gosam_driver_set_alpha_s
	<<Prc gosam: procedures>>=
	module subroutine gosam_driver_set_alpha_s (driver, alpha_s)
	class(gosam_driver_t), intent(in) :: driver
	real(default), intent(in) :: alpha_s
	integer :: ierr
	call driver%blha_olp_set_parameter &
	(c_char_'alphaS'//c_null_char, &
	dble (alpha_s), 0._double, ierr)
	end subroutine gosam_driver_set_alpha_s

	@ %def gosam_driver_set_alpha_s
	@
	<<Prc gosam: gosam driver: TBP>>=
	procedure :: set_alpha_qed => gosam_driver_set_alpha_qed
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_driver_set_alpha_qed (driver, alpha)
	class(gosam_driver_t), intent(inout) :: driver
	real(default), intent(in) :: alpha
	end subroutine gosam_driver_set_alpha_qed
	<<Prc gosam: procedures>>=
	module subroutine gosam_driver_set_alpha_qed (driver, alpha)
	class(gosam_driver_t), intent(inout) :: driver
	real(default), intent(in) :: alpha
	integer :: ierr
	call driver%blha_olp_set_parameter &
	(c_char_'alpha'//c_null_char, &
	dble (alpha), 0._double, ierr)
	if (ierr == 0) call ew_parameter_error_message (var_str ('alpha'))
	end subroutine gosam_driver_set_alpha_qed

	@ %def gosam_driver_set_alpha_qed
	@
	<<Prc gosam: gosam driver: TBP>>=
	procedure :: set_GF => gosam_driver_set_GF
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_driver_set_GF (driver, GF)
	class(gosam_driver_t), intent(inout) :: driver
	real(default), intent(in) :: GF
	end subroutine gosam_driver_set_GF
	<<Prc gosam: procedures>>=
	module subroutine gosam_driver_set_GF (driver, GF)
	class(gosam_driver_t), intent(inout) :: driver
	real(default), intent(in) :: GF
	integer :: ierr
	call driver%blha_olp_set_parameter &
	(c_char_'GF'//c_null_char, &
	dble(GF), 0._double, ierr)
	if (ierr == 0) call ew_parameter_error_message (var_str ('GF'))
	end subroutine gosam_driver_set_GF

	@ %def gosam_driver_set_GF
	@
	<<Prc gosam: gosam driver: TBP>>=
	procedure :: set_weinberg_angle => gosam_driver_set_weinberg_angle
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_driver_set_weinberg_angle (driver, sw2)
	class(gosam_driver_t), intent(inout) :: driver
	real(default), intent(in) :: sw2
	end subroutine gosam_driver_set_weinberg_angle
	<<Prc gosam: procedures>>=
	module subroutine gosam_driver_set_weinberg_angle (driver, sw2)
	class(gosam_driver_t), intent(inout) :: driver
	real(default), intent(in) :: sw2
	integer :: ierr
	call driver%blha_olp_set_parameter &
	(c_char_'sw2'//c_null_char, &
	dble(sw2), 0._double, ierr)
	if (ierr == 0) call ew_parameter_error_message (var_str ('sw2'))
	end subroutine gosam_driver_set_weinberg_angle

	@ %def gosam_driver_set_weinberg_angle
	@
	<<Prc gosam: gosam driver: TBP>>=
	+ procedure :: set_ufo_parameter => gosam_driver_set_ufo_parameter
	+<<Prc gosam: sub interfaces>>=
	+ module subroutine gosam_driver_set_ufo_parameter (driver, par_name, ufo_par)
	+ class(gosam_driver_t), intent(inout) :: driver
	+ type(string_t), intent(in) :: par_name
	+ real(default), intent(in) :: ufo_par
	+ end subroutine gosam_driver_set_ufo_parameter
	+<<Prc gosam: procedures>>=
	+ module subroutine gosam_driver_set_ufo_parameter (driver, par_name, ufo_par)
	+ class(gosam_driver_t), intent(inout) :: driver
	+ type(string_t), intent(in) :: par_name
	+ real(default), intent(in) :: ufo_par
	+ integer :: ierr
	+ call driver%blha_olp_set_parameter &
	+ (c_char_'mdl'//char(par_name)//c_null_char, &
	+ dble(ufo_par), 0._double, ierr)
	+ if (ierr == 0) call msg_fatal ('UFO parameter cannot be set by OLP.')
	+ end subroutine gosam_driver_set_ufo_parameter
	+
	+@ %def gosam_driver_set_ufo_parameter
	+@
	+<<Prc gosam: gosam driver: TBP>>=
	procedure :: print_alpha_s => gosam_driver_print_alpha_s
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_driver_print_alpha_s (object)
	class(gosam_driver_t), intent(in) :: object
	end subroutine gosam_driver_print_alpha_s
	<<Prc gosam: procedures>>=
	module subroutine gosam_driver_print_alpha_s (object)
	class(gosam_driver_t), intent(in) :: object
	call object%blha_olp_print_parameter (c_char_'alphaS'//c_null_char)
	end subroutine gosam_driver_print_alpha_s

	@ %def gosam_driver_print_alpha_s
	@
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: prepare_library => prc_gosam_prepare_library
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_prepare_library (object, os_data, libname)
	class(prc_gosam_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	end subroutine prc_gosam_prepare_library
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_prepare_library (object, os_data, libname)
	class(prc_gosam_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	select type (writer => object%def%writer)
	type is (gosam_writer_t)
	call writer%write_config ()
	end select
	call object%create_olp_library (libname)
	call object%load_driver (os_data)
	end subroutine prc_gosam_prepare_library

	@ %def prc_gosam_prepare_library
	@
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: prepare_external_code => &
	prc_gosam_prepare_external_code
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_gosam_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	end subroutine prc_gosam_prepare_external_code
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_gosam_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	core%sqme_tree_pos = 4
	call core%prepare_library (os_data, libname)
	call core%start ()
	call core%read_contract_file (flv_states)
	- call core%set_particle_properties (model)
	- call core%set_electroweak_parameters (model)
	+ if (model%is_ufo_model ()) then
	+ call core%set_ufo_parameters (model)
	+ else
	+ call core%set_particle_properties (model)
	+ call core%set_electroweak_parameters (model)
	+ end if
	call core%print_parameter_file (i_core)
	end subroutine prc_gosam_prepare_external_code

	@ %def prc_gosam_prepare_external_code
	@
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: write_makefile => prc_gosam_write_makefile
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_write_makefile (object, unit, libname)
	class(prc_gosam_t), intent(in) :: object
	integer, intent(in) :: unit
	type(string_t), intent(in) :: libname
	end subroutine prc_gosam_write_makefile
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_write_makefile (object, unit, libname)
	class(prc_gosam_t), intent(in) :: object
	integer, intent(in) :: unit
	type(string_t), intent(in) :: libname
	select type (driver => object%driver)
	type is (gosam_driver_t)
	call driver%write_makefile (unit, libname)
	end select
	end subroutine prc_gosam_write_makefile

	@ %def prc_gosam_write_makefile
	@
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: execute_makefile => prc_gosam_execute_makefile
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_execute_makefile (object, libname)
	class(prc_gosam_t), intent(in) :: object
	type(string_t), intent(in) :: libname
	end subroutine prc_gosam_execute_makefile
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_execute_makefile (object, libname)
	class(prc_gosam_t), intent(in) :: object
	type(string_t), intent(in) :: libname
	select type (driver => object%driver)
	type is (gosam_driver_t)
	call os_system_call ("make -f " // &
	libname // "_gosam.makefile")
	end select
	end subroutine prc_gosam_execute_makefile

	@ %def prc_gosam_execute_makefile
	@
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: create_olp_library => prc_gosam_create_olp_library
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_create_olp_library (object, libname)
	class(prc_gosam_t), intent(inout) :: object
	type(string_t), intent(in) :: libname
	end subroutine prc_gosam_create_olp_library
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_create_olp_library (object, libname)
	class(prc_gosam_t), intent(inout) :: object
	type(string_t), intent(in) :: libname
	integer :: unit
	select type (driver => object%driver)
	type is (gosam_driver_t)
	unit = free_unit ()
	open (unit, file = char (libname // "_gosam.makefile"), &
	status = "replace", action= "write")
	call object%write_makefile (unit, libname)
	close (unit)
	call object%execute_makefile (libname)
	end select
	end subroutine prc_gosam_create_olp_library

	@ %def prc_gosam_create_olp_library
	@
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: load_driver => prc_gosam_load_driver
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_load_driver (object, os_data)
	class(prc_gosam_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	end subroutine prc_gosam_load_driver
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_load_driver (object, os_data)
	class(prc_gosam_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	logical :: dl_success

	select type (driver => object%driver)
	type is (gosam_driver_t)
	call driver%load (os_data, dl_success)
	if (.not. dl_success) &
	call msg_fatal ("GoSam Libraries could not be loaded")
	end select
	end subroutine prc_gosam_load_driver

	@ %def prc_gosam_load_driver
	@
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: start => prc_gosam_start
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_start (object)
	class(prc_gosam_t), intent(inout) :: object
	end subroutine prc_gosam_start
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_start (object)
	class(prc_gosam_t), intent(inout) :: object
	integer :: ierr
	if (object%includes_polarization()) &
	call msg_fatal ('GoSam does not support polarized beams!')
	select type (driver => object%driver)
	type is (gosam_driver_t)
	call driver%blha_olp_start (string_f2c (driver%contract_file), ierr)
	end select
	end subroutine prc_gosam_start

	@ %def prc_gosam_start
	@
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: write => prc_gosam_write
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_write (object, unit)
	class(prc_gosam_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_gosam_write
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_write (object, unit)
	class(prc_gosam_t), intent(in) :: object
	integer, intent(in), optional :: unit
	call msg_message (unit = unit, string = "GOSAM")
	end subroutine prc_gosam_write

	-@
	@ %def prc_gosam_write
	+@
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: write_name => prc_gosam_write_name
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_write_name (object, unit)
	class(prc_gosam_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_gosam_write_name
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_write_name (object, unit)
	class(prc_gosam_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u,"(1x,A)") "Core: GoSam"
	end subroutine prc_gosam_write_name

	@ %def prc_gosam_write_name
	@
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: init_driver => prc_gosam_init_driver
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_init_driver (object, os_data)
	class(prc_gosam_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	end subroutine prc_gosam_init_driver
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_init_driver (object, os_data)
	class(prc_gosam_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	type(string_t) :: olp_file, olc_file, olp_dir
	type(string_t) :: suffix

	select type (def => object%def)
	type is (gosam_def_t)
	suffix = def%suffix
	olp_file = def%basename // suffix // '.olp'
	olc_file = def%basename // suffix // '.olc'
	olp_dir = def%basename // suffix // '_olp_modules'
	class default
	call msg_bug ("prc_gosam_init_driver: core_def should be of gosam-type")
	end select

	select type(driver => object%driver)
	type is (gosam_driver_t)
	driver%nlo_suffix = suffix
	call driver%init_gosam (os_data, olp_file, olc_file, olp_dir, &
	var_str ("libgolem_olp"))
	end select
	end subroutine prc_gosam_init_driver

	@ %def prc_gosam_init_driver
	@
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: set_initialized => prc_gosam_set_initialized
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_set_initialized (prc_gosam)
	class(prc_gosam_t), intent(inout) :: prc_gosam
	end subroutine prc_gosam_set_initialized
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_set_initialized (prc_gosam)
	class(prc_gosam_t), intent(inout) :: prc_gosam
	prc_gosam%initialized = .true.
	end subroutine prc_gosam_set_initialized

	@ %def prc_gosam_set_initialized
	@ The BLHA-interface conventions require the quantity $S_{ij} = \langle
	M_{i,+}\|T_iT_j\|M_{i,-}\rangle$ to be produced, where $i$ is the position
	of the splitting gluon. However, $\tilde{M} = \langle
	M_{i,-}\|M_{i,+}\rangle$ is needed. This can be obtained using color
	conservation, $\sum_{j} T_j\|M\rangle = 0$, so that
	\begin{equation*}
	\sum_{j \neq i} S_{ij} = -\langle M_{i,+}\|T_i^2\|M_{i,-}\rangle = -C_A
	\langle M_{i,+}\|M_{i,-}\rangle = -C_A \tilde{M}^*
	\end{equation*}
	According to BLHA conventions, the real part of $S_{ij}$ is located at
	positions $2i + 2nj$ in the output array, where $n$ denotes the number
	of external particles and the enumeration of particles starts at zero.
	The subsequent position, i.e. $2i + 2nj + 1$ is designated to the
	imaginary part of $S_{ij}$. Note that, since the first array position
	is 1, the implemented position association deviates from the above one
	-in the addition of 1.
	-<<Prc gosam: procedures>>=
	+in the addition of 1. This is here implemented in the form
	+[[compute_sqme_spin_c_blha]]. In the routine [[compute_sqme_spin_c]],
	+this is a dedicated routine from [[GoSam]] is called, in the same
	+spirit as for [[OpenLoops]].
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: compute_sqme_spin_c => prc_gosam_compute_sqme_spin_c
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_compute_sqme_spin_c (object, &
	+ i_flv, i_hel, p, ren_scale, sqme_spin_c, bad_point)
	+ class(prc_gosam_t), intent(inout) :: object
	+ integer, intent(in) :: i_flv, i_hel
	+ type(vector4_t), intent(in), dimension(:) :: p
	+ real(default), intent(in) :: ren_scale
	+ real(default), intent(out), dimension(OLP_RESULTS_LIMIT) :: sqme_spin_c
	+ logical, intent(out) :: bad_point
	+ end subroutine prc_gosam_compute_sqme_spin_c
	+<<Prc gosam: procedures>>=
	+ module subroutine prc_gosam_compute_sqme_spin_c (object, &
	+ i_flv, i_hel, p, ren_scale, sqme_spin_c, bad_point)
	+ class(prc_gosam_t), intent(inout) :: object
	+ integer, intent(in) :: i_flv, i_hel
	+ type(vector4_t), intent(in), dimension(:) :: p
	+ real(default), intent(in) :: ren_scale
	+ real(default), intent(out), dimension(OLP_RESULTS_LIMIT) :: sqme_spin_c
	+ logical, intent(out) :: bad_point
	+ real(double), dimension(5*object%n_particles) :: mom
	+ real(double), dimension(OLP_RESULTS_LIMIT) :: r
	+ real(double) :: ren_scale_dble
	+ real(double) :: acc, acc_dble
	+ real(default) :: alpha_s
	+ if (object%i_spin_c(i_flv, i_hel) >= 0) then
	+ mom = object%create_momentum_array (p)
	+ if (vanishes (ren_scale)) call msg_fatal &
	+ ("prc_gosam_compute_sqme_spin_c: ren_scale vanishes")
	+ alpha_s = object%qcd%alpha%get (ren_scale)
	+ select type (driver => object%driver)
	+ type is (gosam_driver_t)
	+ call driver%set_alpha_s (alpha_s)
	+ call driver%blha_olp_eval2 (object%i_spin_c(i_flv, i_hel), &
	+ mom, ren_scale_dble, r, acc_dble)
	+ end select
	+ sqme_spin_c = r
	+
	+ ! acc = acc_dble
	+ ! if (acc > object%maximum_accuracy) bad_point = .true.
	+ bad_point = .false.
	+ else
	+ sqme_spin_c = zero
	+ end if
	+ end subroutine prc_gosam_compute_sqme_spin_c
	+
	+@ %def prc_gosam_compute_sqme_spin_c
	+@ This routine would use the BLHA interface to call the
	+spin-correlated matrix elements. However, this is not supported on the
	+\texttt{GoSam} side.
	+<<Prc gosam: prc gosam: TBP>>=
	+ procedure :: compute_sqme_spin_c_blha => prc_gosam_compute_sqme_spin_c_blha
	+<<Prc gosam: sub interfaces>>=
	+ module subroutine prc_gosam_compute_sqme_spin_c_blha (object, &
	i_flv, i_hel, em, p, ren_scale, me_sc, bad_point)
	class(prc_gosam_t), intent(inout) :: object
	integer, intent(in) :: i_flv, i_hel
	integer, intent(in) :: em
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	complex(default), intent(out) :: me_sc
	logical, intent(out) :: bad_point
	- end subroutine prc_gosam_compute_sqme_spin_c
	+ end subroutine prc_gosam_compute_sqme_spin_c_blha
	<<Prc gosam: procedures>>=
	- module subroutine prc_gosam_compute_sqme_spin_c (object, &
	+ module subroutine prc_gosam_compute_sqme_spin_c_blha (object, &
	i_flv, i_hel, em, p, ren_scale, me_sc, bad_point)
	class(prc_gosam_t), intent(inout) :: object
	integer, intent(in) :: i_flv, i_hel
	integer, intent(in) :: em
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	complex(default), intent(out) :: me_sc
	logical, intent(out) :: bad_point
	real(double), dimension(5*object%n_particles) :: mom
	real(double), dimension(OLP_RESULTS_LIMIT) :: r
	real(double) :: ren_scale_dble
	integer :: i, igm1, n
	integer :: pos_real, pos_imag
	real(double) :: acc_dble
	real(default) :: acc, alpha_s
	if (object%i_spin_c(i_flv, i_hel) >= 0) then
	me_sc = cmplx (zero ,zero, kind=default)
	mom = object%create_momentum_array (p)
	if (vanishes (ren_scale)) &
	call msg_fatal ("prc_gosam_compute_sqme_spin_c: ren_scale vanishes")
	alpha_s = object%qcd%alpha%get (ren_scale)
	ren_scale_dble = dble (ren_scale)
	select type (driver => object%driver)
	type is (gosam_driver_t)
	call driver%set_alpha_s (alpha_s)
	call driver%blha_olp_eval2 (object%i_spin_c(i_flv, i_hel), &
	mom, ren_scale_dble, r, acc_dble)
	end select
	igm1 = em - 1
	n = size(p)
	do i = 0, n - 1
	pos_real = 2 * igm1 + 2 * n * i + 1
	pos_imag = pos_real + 1
	me_sc = me_sc + cmplx (r(pos_real), r(pos_imag), default)
	end do

	me_sc = - conjg(me_sc) / CA

	acc = acc_dble
	if (acc > object%maximum_accuracy) bad_point = .true.
	else
	r = 0._double
	end if
	- end subroutine prc_gosam_compute_sqme_spin_c
	+ end subroutine prc_gosam_compute_sqme_spin_c_blha

	-@ %def prc_gosam_compute_sqme_spin_c
	+@ %def prc_gosam_compute_sqme_spin_c_blha
	@ Gfortran 7/8/9 bug, has to remain in main module.
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: allocate_workspace => prc_gosam_allocate_workspace
	<<Prc gosam: main procedures>>=
	subroutine prc_gosam_allocate_workspace (object, core_state)
	class(prc_gosam_t), intent(in) :: object
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	allocate (gosam_state_t :: core_state)
	end subroutine prc_gosam_allocate_workspace

	@ %def prc_gosam_allocate_workspace
	@
	<<Prc gosam: gosam state: TBP>>=
	procedure :: write => gosam_state_write
	<<Prc gosam: sub interfaces>>=
	module subroutine gosam_state_write (object, unit)
	class(gosam_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine gosam_state_write
	<<Prc gosam: procedures>>=
	module subroutine gosam_state_write (object, unit)
	class(gosam_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	call msg_warning (unit = unit, string = "gosam_state_write: What to write?")
	end subroutine gosam_state_write

	@ %def prc_gosam_state_write
	-@
	+@ The [[MassiveParticles]] entry before forces \texttt{GoSam}
	+to create only amplitudes for massive/massless particles according to
	+that list. This list was already filtered for particles potentially
	+declared massless. These must appear again here.
	<<Prc gosam: prc gosam: TBP>>=
	procedure :: set_particle_properties => prc_gosam_set_particle_properties
	<<Prc gosam: sub interfaces>>=
	module subroutine prc_gosam_set_particle_properties (object, model)
	class(prc_gosam_t), intent(inout) :: object
	class(model_data_t), intent(in), target :: model
	end subroutine prc_gosam_set_particle_properties
	<<Prc gosam: procedures>>=
	module subroutine prc_gosam_set_particle_properties (object, model)
	class(prc_gosam_t), intent(inout) :: object
	class(model_data_t), intent(in), target :: model
	integer :: i, i_pdg
	type(flavor_t) :: flv
	real(default) :: mass, width
	integer :: ierr
	real(default) :: top_yukawa
	do i = 1, OLP_N_MASSIVE_PARTICLES
	i_pdg = OLP_MASSIVE_PARTICLES(i)
	if (i_pdg < 0) cycle
	call flv%init (i_pdg, model)
	mass = flv%get_mass (); width = flv%get_width ()
	select type (driver => object%driver)
	class is (blha_driver_t)
	- if (i_pdg == 13) then
	- call driver%set_mass_and_width (i_pdg, mass = mass)
	- else
	- call driver%set_mass_and_width (i_pdg, mass = mass, width = width)
	+ if (mass > 0) then
	+ if (flv%mass_is_input () .and. flv%width_is_input ()) then
	+ call driver%set_mass_and_width (i_pdg, mass = mass, width = width)
	+ else if (flv%mass_is_input () .and. .not. flv%width_is_input ()) then
	+ call driver%set_mass_and_width (i_pdg, mass = mass)
	+ else if (.not. flv%mass_is_input () .and. flv%width_is_input ()) then
	+ call driver%set_mass_and_width (i_pdg, width = width)
	+ end if
	end if
	if (i_pdg == 5) call driver%blha_olp_set_parameter &
	('yuk(5)'//c_null_char, dble(mass), 0._double, ierr)
	if (i_pdg == 6) then
	if (driver%external_top_yukawa > 0._default) then
	top_yukawa = driver%external_top_yukawa
	else
	top_yukawa = mass
	end if
	call driver%blha_olp_set_parameter &
	('yuk(6)'//c_null_char, dble(top_yukawa), 0._double, ierr)
	end if
	if (driver%switch_off_muon_yukawas) then
	if (i_pdg == 13) call driver%blha_olp_set_parameter &
	('yuk(13)' //c_null_char, 0._double, 0._double, ierr)
	end if
	end select
	end do
	end subroutine prc_gosam_set_particle_properties

	@ %def prc_gosam_set_particle_properties
	Index: trunk/src/process_integration/process_integration.nw
	===================================================================
	--- trunk/src/process_integration/process_integration.nw (revision 8903)
	+++ trunk/src/process_integration/process_integration.nw (revision 8904)
	@@ -1,23965 +1,23998 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: integration and process objects and such
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Integration and Process Objects}
	\includemodulegraph{process_integration}

	This is the central part of the \whizard\ package. It provides the
	functionality for evaluating structure functions, kinematics and matrix
	elements, integration and event generation. It combines the various
	parts that deal with those tasks individually and organizes the data
	transfer between them.

	\begin{description}
	\item[subevt\_expr]
	This enables process observables as (abstract) expressions, to be
	evaluated for each process call.
	\item[parton\_states]
	A [[parton_state_t]] object represents an elementary partonic
	interaction. There are two versions: one for the isolated
	elementary process, one for the elementary process convoluted with
	the structure-function chain. The parton state is an effective
	state. It needs not coincide with the seed-kinematics state which is
	used in evaluating phase space.
	\item[process]
	Here, all pieces are combined for the purpose of evaluating the
	elementary processes. The whole algorithm is coded in terms of
	abstract data types as defined in the appropriate modules: [[prc_core]]
	for matrix-element evaluation, [[prc_core_def]] for the associated
	configuration and driver, [[sf_base]] for beams and structure-functions,
	[[phs_base]] for phase space, and [[mci_base]] for integration and event
	generation.
	\item[process\_config]
	\item[process\_counter]
	Very simple object for statistics
	\item[process\_mci]
	\item[pcm]
	\item[kinematics]
	\item[instances]
	While the above modules set up all static information, the instances
	have the changing event data. There are term and process instances but
	no component instances.
	\item[process\_stacks]
	Process stacks collect process objects.
	\end{description}

	We combine here hard interactions, phase space, and (for scatterings)
	structure functions and interfaces them to the integration module.

	The process object implements the combination of a fixed beam and
	structure-function setup with a number of elementary processes. The
	latter are called process components. The process object
	represents an entity which is supposedly observable. It should
	be meaningful to talk about the cross section of a process.

	The individual components of a process are, technically, processes
	themselves, but they may have unphysical cross sections which have to
	be added for a physical result. Process components may be exclusive
	tree-level elementary processes, dipole subtraction term, loop
	corrections, etc.

	The beam and structure function setup is common to all process
	components. Thus, there is only one instance of this part.

	The process may be a scattering process or a decay process. In the
	latter case, there are no structure functions, and the beam setup
	consists of a single particle. Otherwise, the two classes are treated
	on the same footing.

	Once a sampling point has been chosen, a process determines a set of
	partons with a correlated density matrix of quantum numbers. In
	general, each sampling point will generate, for each process component,
	one or more distinct parton configurations. This is the [[computed]]
	state. The computed state is the subject of the multi-channel
	integration algorithm.

	For NLO computations, it is necessary to project the computed states
	onto another set of parton configurations (e.g., by recombining
	certain pairs). This is the [[observed]] state. When computing
	partonic observables, the information is taken from the observed
	state.

	For the purpose of event generation, we will later select one parton
	configuration from the observed state and collapse the correlated
	quantum state. This configuration is then dressed by applying parton
	shower, decays and hadronization. The decay chain, in particular,
	combines a scattering process with possible subsequent decay processes
	on the parton level, which are full-fledged process objects themselves.

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process observables}
	We define an abstract [[subevt_expr_t]] object as an extension of the
	[[subevt_t]] type. The object contains a local variable list, variable
	instances (as targets for pointers in the variable list), and evaluation
	trees. The evaluation trees reference both the variables and the [[subevt]].

	There are two instances of the abstract type: one for process instances, one
	for physical events. Both have a common logical expression [[selection]]
	which determines whether the object passes user-defined cuts.

	The intention is that we fill the [[subevt_t]] base object and compute the
	variables once we have evaluated a kinematical phase space point (or a
	complete event). We then evaluate the expressions and can use the results in
	further calculations.

	The [[process_expr_t]] extension contains furthermore scale and weight
	expressions. The [[event_expr_t]] extension contains a reweighting-factor
	expression and a logical expression for event analysis. In practice, we will
	link the variable list of the [[event_obs]] object to the variable list of the
	currently active [[process_obs]] object, such that the process variables are
	available to both objects. Event variables are meaningful only for physical
	events.

	Note that there are unit tests, but they are deferred to the
	[[expr_tests]] module.
	<<[[subevt_expr.f90]]>>=
	<<File header>>
	module subevt_expr

	<<Use kinds>>
	<<Use strings>>
	use lorentz
	use subevents
	use variables
	use flavors
	use quantum_numbers
	use interactions
	use particles
	use expr_base

	<<Standard module head>>

	<<Subevt expr: public>>

	<<Subevt expr: types>>

	<<Subevt expr: interfaces>>

	interface
	<<Subevt expr: sub interfaces>>
	end interface

	end module subevt_expr
	@ %def subevt_expr
	@
	<<[[subevt_expr_sub.f90]]>>=
	<<File header>>

	submodule (subevt_expr) subevt_expr_s

	use constants, only: zero, one
	use io_units
	use format_utils, only: write_separator
	use diagnostics

	implicit none

	contains

	<<Subevt expr: procedures>>

	end submodule subevt_expr_s

	@ %def subevt_expr_s
	@
	\subsection{Abstract base type}
	<<Subevt expr: types>>=
	type, extends (subevt_t), abstract :: subevt_expr_t
	logical :: subevt_filled = .false.
	type(var_list_t) :: var_list
	real(default) :: sqrts_hat = 0
	integer :: n_in = 0
	integer :: n_out = 0
	integer :: n_tot = 0
	logical :: has_selection = .false.
	class(expr_t), allocatable :: selection
	logical :: colorize_subevt = .false.
	contains
	<<Subevt expr: subevt expr: TBP>>
	end type subevt_expr_t

	@ %def subevt_expr_t
	@ Output: Base and extended version. We already have a [[write]] routine for
	the [[subevt_t]] parent type.
	<<Subevt expr: subevt expr: TBP>>=
	procedure :: base_write => subevt_expr_write
	<<Subevt expr: sub interfaces>>=
	module subroutine subevt_expr_write (object, unit, pacified)
	class(subevt_expr_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacified
	end subroutine subevt_expr_write
	<<Subevt expr: procedures>>=
	module subroutine subevt_expr_write (object, unit, pacified)
	class(subevt_expr_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacified
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Local variables:"
	call write_separator (u)
	call object%var_list%write (u, follow_link=.false., &
	pacified = pacified)
	call write_separator (u)
	if (object%subevt_filled) then
	call object%subevt_t%write (u, pacified = pacified)
	if (object%has_selection) then
	call write_separator (u)
	write (u, "(1x,A)") "Selection expression:"
	call write_separator (u)
	call object%selection%write (u)
	end if
	else
	write (u, "(1x,A)") "subevt: [undefined]"
	end if
	end subroutine subevt_expr_write

	@ %def subevt_expr_write
	@ Finalizer.
	<<Subevt expr: subevt expr: TBP>>=
	procedure (subevt_expr_final), deferred :: final
	procedure :: base_final => subevt_expr_final
	<<Subevt expr: sub interfaces>>=
	module subroutine subevt_expr_final (object)
	class(subevt_expr_t), intent(inout) :: object
	end subroutine subevt_expr_final
	<<Subevt expr: procedures>>=
	module subroutine subevt_expr_final (object)
	class(subevt_expr_t), intent(inout) :: object
	call object%var_list%final ()
	if (object%has_selection) then
	call object%selection%final ()
	end if
	end subroutine subevt_expr_final

	@ %def subevt_expr_final
	@
	\subsection{Initialization}
	Initialization: define local variables and establish pointers.

	The common variables are [[sqrts]] (the nominal beam energy, fixed),
	[[sqrts_hat]] (the actual energy), [[n_in]], [[n_out]], and [[n_tot]] for
	the [[subevt]]. With the exception of [[sqrts]], all are implemented as
	pointers to subobjects.
	<<Subevt expr: subevt expr: TBP>>=
	procedure (subevt_expr_setup_vars), deferred :: setup_vars
	procedure :: base_setup_vars => subevt_expr_setup_vars
	<<Subevt expr: sub interfaces>>=
	module subroutine subevt_expr_setup_vars (expr, sqrts)
	class(subevt_expr_t), intent(inout), target :: expr
	real(default), intent(in) :: sqrts
	end subroutine subevt_expr_setup_vars
	<<Subevt expr: procedures>>=
	module subroutine subevt_expr_setup_vars (expr, sqrts)
	class(subevt_expr_t), intent(inout), target :: expr
	real(default), intent(in) :: sqrts
	call expr%var_list%final ()
	call expr%var_list%append_real (var_str ("sqrts"), sqrts, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call expr%var_list%append_real_ptr (var_str ("sqrts_hat"), &
	expr%sqrts_hat, is_known = expr%subevt_filled, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call expr%var_list%append_int_ptr (var_str ("n_in"), expr%n_in, &
	is_known = expr%subevt_filled, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call expr%var_list%append_int_ptr (var_str ("n_out"), expr%n_out, &
	is_known = expr%subevt_filled, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call expr%var_list%append_int_ptr (var_str ("n_tot"), expr%n_tot, &
	is_known = expr%subevt_filled, &
	locked = .true., verbose = .false., intrinsic = .true.)
	end subroutine subevt_expr_setup_vars

	@ %def subevt_expr_setup_vars
	@ Append the subevent expr (its base-type core) itself to the variable
	list, if it is not yet present.
	<<Subevt expr: subevt expr: TBP>>=
	procedure :: setup_var_self => subevt_expr_setup_var_self
	<<Subevt expr: sub interfaces>>=
	module subroutine subevt_expr_setup_var_self (expr)
	class(subevt_expr_t), intent(inout), target :: expr
	end subroutine subevt_expr_setup_var_self
	<<Subevt expr: procedures>>=
	module subroutine subevt_expr_setup_var_self (expr)
	class(subevt_expr_t), intent(inout), target :: expr
	if (.not. expr%var_list%contains (var_str ("@evt"))) then
	call expr%var_list%append_subevt_ptr &
	(var_str ("@evt"), expr%subevt_t, &
	is_known = expr%subevt_filled, &
	locked = .true., verbose = .false., intrinsic=.true.)
	end if
	end subroutine subevt_expr_setup_var_self

	@ %def subevt_expr_setup_var_self
	@ Link a variable list to the local one. This could be done event by event,
	but before evaluating expressions.
	<<Subevt expr: subevt expr: TBP>>=
	procedure :: link_var_list => subevt_expr_link_var_list
	<<Subevt expr: sub interfaces>>=
	module subroutine subevt_expr_link_var_list (expr, var_list)
	class(subevt_expr_t), intent(inout) :: expr
	type(var_list_t), intent(in), target :: var_list
	end subroutine subevt_expr_link_var_list
	<<Subevt expr: procedures>>=
	module subroutine subevt_expr_link_var_list (expr, var_list)
	class(subevt_expr_t), intent(inout) :: expr
	type(var_list_t), intent(in), target :: var_list
	call expr%var_list%link (var_list)
	end subroutine subevt_expr_link_var_list

	@ %def subevt_expr_link_var_list
	@ Compile the selection expression. If there is no expression, the build
	method will not allocate the expression object.
	<<Subevt expr: subevt expr: TBP>>=
	procedure :: setup_selection => subevt_expr_setup_selection
	<<Subevt expr: sub interfaces>>=
	module subroutine subevt_expr_setup_selection (expr, ef_cuts)
	class(subevt_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_cuts
	end subroutine subevt_expr_setup_selection
	<<Subevt expr: procedures>>=
	module subroutine subevt_expr_setup_selection (expr, ef_cuts)
	class(subevt_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_cuts
	call ef_cuts%build (expr%selection)
	if (allocated (expr%selection)) then
	call expr%setup_var_self ()
	call expr%selection%setup_lexpr (expr%var_list)
	expr%has_selection = .true.
	end if
	end subroutine subevt_expr_setup_selection

	@ %def subevt_expr_setup_selection
	@ (De)activate color storage and evaluation for the expression. The subevent
	particles will have color information.
	<<Subevt expr: subevt expr: TBP>>=
	procedure :: colorize => subevt_expr_colorize
	<<Subevt expr: sub interfaces>>=
	module subroutine subevt_expr_colorize (expr, colorize_subevt)
	class(subevt_expr_t), intent(inout), target :: expr
	logical, intent(in) :: colorize_subevt
	end subroutine subevt_expr_colorize
	<<Subevt expr: procedures>>=
	module subroutine subevt_expr_colorize (expr, colorize_subevt)
	class(subevt_expr_t), intent(inout), target :: expr
	logical, intent(in) :: colorize_subevt
	expr%colorize_subevt = colorize_subevt
	end subroutine subevt_expr_colorize

	@ %def subevt_expr_colorize
	@
	\subsection{Evaluation}
	Reset to initial state, i.e., mark the [[subevt]] as invalid.
	<<Subevt expr: subevt expr: TBP>>=
	procedure :: reset_contents => subevt_expr_reset_contents
	procedure :: base_reset_contents => subevt_expr_reset_contents
	<<Subevt expr: sub interfaces>>=
	module subroutine subevt_expr_reset_contents (expr)
	class(subevt_expr_t), intent(inout) :: expr
	end subroutine subevt_expr_reset_contents
	<<Subevt expr: procedures>>=
	module subroutine subevt_expr_reset_contents (expr)
	class(subevt_expr_t), intent(inout) :: expr
	expr%subevt_filled = .false.
	end subroutine subevt_expr_reset_contents

	@ %def subevt_expr_reset_contents
	@ Evaluate the selection expression and return the result. There is also a
	deferred version: this should evaluate the remaining expressions if the event
	has passed.
	<<Subevt expr: subevt expr: TBP>>=
	procedure :: base_evaluate => subevt_expr_evaluate
	<<Subevt expr: sub interfaces>>=
	module subroutine subevt_expr_evaluate (expr, passed)
	class(subevt_expr_t), intent(inout) :: expr
	logical, intent(out) :: passed
	end subroutine subevt_expr_evaluate
	<<Subevt expr: procedures>>=
	module subroutine subevt_expr_evaluate (expr, passed)
	class(subevt_expr_t), intent(inout) :: expr
	logical, intent(out) :: passed
	if (expr%has_selection) then
	call expr%selection%evaluate ()
	if (expr%selection%is_known ()) then
	passed = expr%selection%get_log ()
	else
	call msg_error ("Evaluate selection expression: result undefined")
	passed = .false.
	end if
	else
	passed = .true.
	end if
	end subroutine subevt_expr_evaluate

	@ %def subevt_expr_evaluate
	@
	\subsection{Implementation for partonic events}
	This implementation contains the expressions that we can evaluate for the
	partonic process during integration.
	<<Subevt expr: public>>=
	public :: parton_expr_t
	<<Subevt expr: types>>=
	type, extends (subevt_expr_t) :: parton_expr_t
	integer, dimension(:), allocatable :: i_beam
	integer, dimension(:), allocatable :: i_in
	integer, dimension(:), allocatable :: i_out
	logical :: has_scale = .false.
	logical :: has_fac_scale = .false.
	logical :: has_ren_scale = .false.
	logical :: has_weight = .false.
	class(expr_t), allocatable :: scale
	class(expr_t), allocatable :: fac_scale
	class(expr_t), allocatable :: ren_scale
	class(expr_t), allocatable :: weight
	contains
	<<Subevt expr: parton expr: TBP>>
	end type parton_expr_t

	@ %def parton_expr_t
	@ Finalizer.
	<<Subevt expr: parton expr: TBP>>=
	procedure :: final => parton_expr_final
	<<Subevt expr: sub interfaces>>=
	module subroutine parton_expr_final (object)
	class(parton_expr_t), intent(inout) :: object
	end subroutine parton_expr_final
	<<Subevt expr: procedures>>=
	module subroutine parton_expr_final (object)
	class(parton_expr_t), intent(inout) :: object
	call object%base_final ()
	if (object%has_scale) then
	call object%scale%final ()
	end if
	if (object%has_fac_scale) then
	call object%fac_scale%final ()
	end if
	if (object%has_ren_scale) then
	call object%ren_scale%final ()
	end if
	if (object%has_weight) then
	call object%weight%final ()
	end if
	end subroutine parton_expr_final

	@ %def parton_expr_final
	@ Output: continue writing the active expressions, after the common selection
	expression.

	Note: the [[prefix]] argument is declared in the [[write]] method of the
	[[subevt_t]] base type. Here, it is unused.
	<<Subevt expr: parton expr: TBP>>=
	procedure :: write => parton_expr_write
	<<Subevt expr: sub interfaces>>=
	module subroutine parton_expr_write (object, unit, prefix, pacified)
	class(parton_expr_t), intent(in) :: object
	integer, intent(in), optional :: unit
	character(*), intent(in), optional :: prefix
	logical, intent(in), optional :: pacified
	end subroutine parton_expr_write
	<<Subevt expr: procedures>>=
	module subroutine parton_expr_write (object, unit, prefix, pacified)
	class(parton_expr_t), intent(in) :: object
	integer, intent(in), optional :: unit
	character(*), intent(in), optional :: prefix
	logical, intent(in), optional :: pacified
	integer :: u
	u = given_output_unit (unit)
	call object%base_write (u, pacified = pacified)
	if (object%subevt_filled) then
	if (object%has_scale) then
	call write_separator (u)
	write (u, "(1x,A)") "Scale expression:"
	call write_separator (u)
	call object%scale%write (u)
	end if
	if (object%has_fac_scale) then
	call write_separator (u)
	write (u, "(1x,A)") "Factorization scale expression:"
	call write_separator (u)
	call object%fac_scale%write (u)
	end if
	if (object%has_ren_scale) then
	call write_separator (u)
	write (u, "(1x,A)") "Renormalization scale expression:"
	call write_separator (u)
	call object%ren_scale%write (u)
	end if
	if (object%has_weight) then
	call write_separator (u)
	write (u, "(1x,A)") "Weight expression:"
	call write_separator (u)
	call object%weight%write (u)
	end if
	end if
	end subroutine parton_expr_write

	@ %def parton_expr_write
	@ Define variables.
	<<Subevt expr: parton expr: TBP>>=
	procedure :: setup_vars => parton_expr_setup_vars
	<<Subevt expr: sub interfaces>>=
	module subroutine parton_expr_setup_vars (expr, sqrts)
	class(parton_expr_t), intent(inout), target :: expr
	real(default), intent(in) :: sqrts
	end subroutine parton_expr_setup_vars
	<<Subevt expr: procedures>>=
	module subroutine parton_expr_setup_vars (expr, sqrts)
	class(parton_expr_t), intent(inout), target :: expr
	real(default), intent(in) :: sqrts
	call expr%base_setup_vars (sqrts)
	end subroutine parton_expr_setup_vars

	@ %def parton_expr_setup_vars
	@ Compile the scale expressions. If a pointer is disassociated, there is
	no expression.
	<<Subevt expr: parton expr: TBP>>=
	procedure :: setup_scale => parton_expr_setup_scale
	procedure :: setup_fac_scale => parton_expr_setup_fac_scale
	procedure :: setup_ren_scale => parton_expr_setup_ren_scale
	<<Subevt expr: sub interfaces>>=
	module subroutine parton_expr_setup_scale (expr, ef_scale)
	class(parton_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_scale
	end subroutine parton_expr_setup_scale
	module subroutine parton_expr_setup_fac_scale (expr, ef_fac_scale)
	class(parton_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_fac_scale
	end subroutine parton_expr_setup_fac_scale
	module subroutine parton_expr_setup_ren_scale (expr, ef_ren_scale)
	class(parton_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_ren_scale
	end subroutine parton_expr_setup_ren_scale
	<<Subevt expr: procedures>>=
	module subroutine parton_expr_setup_scale (expr, ef_scale)
	class(parton_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_scale
	call ef_scale%build (expr%scale)
	if (allocated (expr%scale)) then
	call expr%setup_var_self ()
	call expr%scale%setup_expr (expr%var_list)
	expr%has_scale = .true.
	end if
	end subroutine parton_expr_setup_scale

	module subroutine parton_expr_setup_fac_scale (expr, ef_fac_scale)
	class(parton_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_fac_scale
	call ef_fac_scale%build (expr%fac_scale)
	if (allocated (expr%fac_scale)) then
	call expr%setup_var_self ()
	call expr%fac_scale%setup_expr (expr%var_list)
	expr%has_fac_scale = .true.
	end if
	end subroutine parton_expr_setup_fac_scale

	module subroutine parton_expr_setup_ren_scale (expr, ef_ren_scale)
	class(parton_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_ren_scale
	call ef_ren_scale%build (expr%ren_scale)
	if (allocated (expr%ren_scale)) then
	call expr%setup_var_self ()
	call expr%ren_scale%setup_expr (expr%var_list)
	expr%has_ren_scale = .true.
	end if
	end subroutine parton_expr_setup_ren_scale

	@ %def parton_expr_setup_scale
	@ %def parton_expr_setup_fac_scale
	@ %def parton_expr_setup_ren_scale
	@ Compile the weight expression.
	<<Subevt expr: parton expr: TBP>>=
	procedure :: setup_weight => parton_expr_setup_weight
	<<Subevt expr: sub interfaces>>=
	module subroutine parton_expr_setup_weight (expr, ef_weight)
	class(parton_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_weight
	end subroutine parton_expr_setup_weight
	<<Subevt expr: procedures>>=
	module subroutine parton_expr_setup_weight (expr, ef_weight)
	class(parton_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_weight
	call ef_weight%build (expr%weight)
	if (allocated (expr%weight)) then
	call expr%setup_var_self ()
	call expr%weight%setup_expr (expr%var_list)
	expr%has_weight = .true.
	end if
	end subroutine parton_expr_setup_weight

	@ %def parton_expr_setup_weight
	@ Filling the partonic state consists of two parts. The first routine
	prepares the subevt without assigning momenta. It takes the particles from an
	[[interaction_t]]. It needs the indices and flavors for the beam,
	incoming, and outgoing particles.

	We can assume that the particle content of the subevt does not change.
	Therefore, we set the event variables [[n_in]], [[n_out]], [[n_tot]] already
	in this initialization step.
	<<Subevt expr: parton expr: TBP>>=
	procedure :: setup_subevt => parton_expr_setup_subevt
	<<Subevt expr: sub interfaces>>=
	module subroutine parton_expr_setup_subevt (expr, int, &
	i_beam, i_in, i_out, f_beam, f_in, f_out)
	class(parton_expr_t), intent(inout) :: expr
	type(interaction_t), intent(in), target :: int
	integer, dimension(:), intent(in) :: i_beam, i_in, i_out
	type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
	end subroutine parton_expr_setup_subevt
	<<Subevt expr: procedures>>=
	module subroutine parton_expr_setup_subevt (expr, int, &
	i_beam, i_in, i_out, f_beam, f_in, f_out)
	class(parton_expr_t), intent(inout) :: expr
	type(interaction_t), intent(in), target :: int
	integer, dimension(:), intent(in) :: i_beam, i_in, i_out
	type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
	allocate (expr%i_beam (size (i_beam)))
	allocate (expr%i_in (size (i_in)))
	allocate (expr%i_out (size (i_out)))
	expr%i_beam = i_beam
	expr%i_in = i_in
	expr%i_out = i_out
	call interaction_to_subevt (int, &
	expr%i_beam, expr%i_in, expr%i_out, expr%subevt_t)
	call expr%set_pdg_beam (f_beam%get_pdg ())
	call expr%set_pdg_incoming (f_in%get_pdg ())
	call expr%set_pdg_outgoing (f_out%get_pdg ())
	call expr%set_p2_beam (f_beam%get_mass () ** 2)
	call expr%set_p2_incoming (f_in%get_mass () ** 2)
	call expr%set_p2_outgoing (f_out%get_mass () ** 2)
	expr%n_in = size (i_in)
	expr%n_out = size (i_out)
	expr%n_tot = expr%n_in + expr%n_out
	end subroutine parton_expr_setup_subevt

	@ %def parton_expr_setup_subevt
	<<Subevt expr: parton expr: TBP>>=
	procedure :: renew_flv_content_subevt => parton_expr_renew_flv_content_subevt
	<<Subevt expr: sub interfaces>>=
	module subroutine parton_expr_renew_flv_content_subevt (expr, int, &
	i_beam, i_in, i_out, f_beam, f_in, f_out)
	class(parton_expr_t), intent(inout) :: expr
	type(interaction_t), intent(in), target :: int
	integer, dimension(:), intent(in) :: i_beam, i_in, i_out
	type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
	end subroutine parton_expr_renew_flv_content_subevt
	<<Subevt expr: procedures>>=
	module subroutine parton_expr_renew_flv_content_subevt (expr, int, &
	i_beam, i_in, i_out, f_beam, f_in, f_out)
	class(parton_expr_t), intent(inout) :: expr
	type(interaction_t), intent(in), target :: int
	integer, dimension(:), intent(in) :: i_beam, i_in, i_out
	type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
	expr%i_beam = i_beam
	expr%i_in = i_in
	expr%i_out = i_out
	call expr%set_pdg_beam (f_beam%get_pdg ())
	call expr%set_pdg_incoming (f_in%get_pdg ())
	call expr%set_pdg_outgoing (f_out%get_pdg ())
	expr%n_in = size (i_in)
	expr%n_out = size (i_out)
	expr%n_tot = expr%n_in + expr%n_out
	end subroutine parton_expr_renew_flv_content_subevt

	@ %def parton_expr_renew_flv_content_subevt
	@ Transfer PDG codes, masses (initalization) and momenta to a
	predefined subevent. We use the flavor assignment of the first
	branch in the interaction state matrix. Only incoming and outgoing
	particles are transferred. Switch momentum sign for incoming
	particles.
	<<Subevt expr: interfaces>>=
	interface interaction_momenta_to_subevt
	module procedure interaction_momenta_to_subevt_id
	module procedure interaction_momenta_to_subevt_tr
	end interface

	<<Subevt expr: sub interfaces>>=
	module subroutine interaction_momenta_to_subevt_id &
	(int, j_beam, j_in, j_out, subevt)
	type(interaction_t), intent(in) :: int
	integer, dimension(:), intent(in) :: j_beam, j_in, j_out
	type(subevt_t), intent(inout) :: subevt
	end subroutine interaction_momenta_to_subevt_id
	module subroutine interaction_momenta_to_subevt_tr &
	(int, j_beam, j_in, j_out, lt, subevt)
	type(interaction_t), intent(in) :: int
	integer, dimension(:), intent(in) :: j_beam, j_in, j_out
	type(subevt_t), intent(inout) :: subevt
	type(lorentz_transformation_t), intent(in) :: lt
	end subroutine interaction_momenta_to_subevt_tr
	<<Subevt expr: procedures>>=
	subroutine interaction_to_subevt (int, j_beam, j_in, j_out, subevt)
	type(interaction_t), intent(in), target :: int
	integer, dimension(:), intent(in) :: j_beam, j_in, j_out
	type(subevt_t), intent(out) :: subevt
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: n_beam, n_in, n_out, i, j
	allocate (flv (int%get_n_tot ()))
	flv = quantum_numbers_get_flavor (int%get_quantum_numbers (1))
	n_beam = size (j_beam)
	n_in = size (j_in)
	n_out = size (j_out)
	call subevt_init (subevt, n_beam + n_in + n_out)
	do i = 1, n_beam
	j = j_beam(i)
	call subevt%set_beam (i, flv(j)%get_pdg (), &
	vector4_null, flv(j)%get_mass () ** 2)
	end do
	do i = 1, n_in
	j = j_in(i)
	call subevt%set_incoming (n_beam + i, flv(j)%get_pdg (), &
	vector4_null, flv(j)%get_mass () ** 2)
	end do
	do i = 1, n_out
	j = j_out(i)
	call subevt%set_outgoing (n_beam + n_in + i, &
	flv(j)%get_pdg (), vector4_null, &
	flv(j)%get_mass () ** 2)
	end do
	end subroutine interaction_to_subevt

	module subroutine interaction_momenta_to_subevt_id &
	(int, j_beam, j_in, j_out, subevt)
	type(interaction_t), intent(in) :: int
	integer, dimension(:), intent(in) :: j_beam, j_in, j_out
	type(subevt_t), intent(inout) :: subevt
	call subevt%set_p_beam (- int%get_momenta (j_beam))
	call subevt%set_p_incoming (- int%get_momenta (j_in))
	call subevt%set_p_outgoing (int%get_momenta (j_out))
	end subroutine interaction_momenta_to_subevt_id

	module subroutine interaction_momenta_to_subevt_tr &
	(int, j_beam, j_in, j_out, lt, subevt)
	type(interaction_t), intent(in) :: int
	integer, dimension(:), intent(in) :: j_beam, j_in, j_out
	type(subevt_t), intent(inout) :: subevt
	type(lorentz_transformation_t), intent(in) :: lt
	call subevt%set_p_beam (- lt * int%get_momenta (j_beam))
	call subevt%set_p_incoming (- lt * int%get_momenta (j_in))
	call subevt%set_p_outgoing (lt * int%get_momenta (j_out))
	end subroutine interaction_momenta_to_subevt_tr

	@ %def interaction_momenta_to_subevt
	@ The second part takes the momenta from the interaction object and thus
	completes the subevt. The partonic energy can then be computed.
	<<Subevt expr: parton expr: TBP>>=
	procedure :: fill_subevt => parton_expr_fill_subevt
	<<Subevt expr: sub interfaces>>=
	module subroutine parton_expr_fill_subevt (expr, int)
	class(parton_expr_t), intent(inout) :: expr
	type(interaction_t), intent(in), target :: int
	end subroutine parton_expr_fill_subevt
	<<Subevt expr: procedures>>=
	module subroutine parton_expr_fill_subevt (expr, int)
	class(parton_expr_t), intent(inout) :: expr
	type(interaction_t), intent(in), target :: int
	call interaction_momenta_to_subevt (int, &
	expr%i_beam, expr%i_in, expr%i_out, expr%subevt_t)
	expr%sqrts_hat = expr%get_sqrts_hat ()
	expr%subevt_filled = .true.
	end subroutine parton_expr_fill_subevt

	@ %def parton_expr_fill_subevt
	@ Evaluate, if the event passes the selection. For absent expressions we take
	default values.
	<<Subevt expr: parton expr: TBP>>=
	procedure :: evaluate => parton_expr_evaluate
	<<Subevt expr: sub interfaces>>=
	module subroutine parton_expr_evaluate (expr, passed, scale, fac_scale, &
	ren_scale, weight, scale_forced, force_evaluation)
	class(parton_expr_t), intent(inout) :: expr
	logical, intent(out) :: passed
	real(default), intent(out) :: scale
	real(default), allocatable, intent(out) :: fac_scale
	real(default), allocatable, intent(out) :: ren_scale
	real(default), intent(out) :: weight
	real(default), intent(in), allocatable, optional :: scale_forced
	logical, intent(in), optional :: force_evaluation
	end subroutine parton_expr_evaluate
	<<Subevt expr: procedures>>=
	module subroutine parton_expr_evaluate (expr, passed, scale, fac_scale, &
	ren_scale, weight, scale_forced, force_evaluation)
	class(parton_expr_t), intent(inout) :: expr
	logical, intent(out) :: passed
	real(default), intent(out) :: scale
	real(default), allocatable, intent(out) :: fac_scale
	real(default), allocatable, intent(out) :: ren_scale
	real(default), intent(out) :: weight
	real(default), intent(in), allocatable, optional :: scale_forced
	logical, intent(in), optional :: force_evaluation
	logical :: force_scale, force_eval
	force_scale = .false.; force_eval = .false.
	if (present (scale_forced)) force_scale = allocated (scale_forced)
	if (present (force_evaluation)) force_eval = force_evaluation
	call expr%base_evaluate (passed)
	if (passed .or. force_eval) then
	if (force_scale) then
	scale = scale_forced
	else if (expr%has_scale) then
	call expr%scale%evaluate ()
	if (expr%scale%is_known ()) then
	scale = expr%scale%get_real ()
	else
	call msg_error ("Evaluate scale expression: result undefined")
	scale = zero
	end if
	else
	scale = expr%sqrts_hat
	end if
	if (expr%has_fac_scale) then
	call expr%fac_scale%evaluate ()
	if (expr%fac_scale%is_known ()) then
	if (.not. allocated (fac_scale)) then
	allocate (fac_scale, source = expr%fac_scale%get_real ())
	else
	fac_scale = expr%fac_scale%get_real ()
	end if
	else
	call msg_error ("Evaluate factorization scale expression: &
	&result undefined")
	end if
	end if
	if (expr%has_ren_scale) then
	call expr%ren_scale%evaluate ()
	if (expr%ren_scale%is_known ()) then
	if (.not. allocated (ren_scale)) then
	allocate (ren_scale, source = expr%ren_scale%get_real ())
	else
	ren_scale = expr%ren_scale%get_real ()
	end if
	else
	call msg_error ("Evaluate renormalization scale expression: &
	&result undefined")
	end if
	end if
	if (expr%has_weight) then
	call expr%weight%evaluate ()
	if (expr%weight%is_known ()) then
	weight = expr%weight%get_real ()
	else
	call msg_error ("Evaluate weight expression: result undefined")
	weight = zero
	end if
	else
	weight = one
	end if
	else
	weight = zero
	end if
	end subroutine parton_expr_evaluate

	@ %def parton_expr_evaluate
	@ Return the beam/incoming parton indices.
	<<Subevt expr: parton expr: TBP>>=
	procedure :: get_beam_index => parton_expr_get_beam_index
	procedure :: get_in_index => parton_expr_get_in_index
	<<Subevt expr: sub interfaces>>=
	module subroutine parton_expr_get_beam_index (expr, i_beam)
	class(parton_expr_t), intent(in) :: expr
	integer, dimension(:), intent(out) :: i_beam
	end subroutine parton_expr_get_beam_index
	module subroutine parton_expr_get_in_index (expr, i_in)
	class(parton_expr_t), intent(in) :: expr
	integer, dimension(:), intent(out) :: i_in
	end subroutine parton_expr_get_in_index
	<<Subevt expr: procedures>>=
	module subroutine parton_expr_get_beam_index (expr, i_beam)
	class(parton_expr_t), intent(in) :: expr
	integer, dimension(:), intent(out) :: i_beam
	i_beam = expr%i_beam
	end subroutine parton_expr_get_beam_index

	module subroutine parton_expr_get_in_index (expr, i_in)
	class(parton_expr_t), intent(in) :: expr
	integer, dimension(:), intent(out) :: i_in
	i_in = expr%i_in
	end subroutine parton_expr_get_in_index

	@ %def parton_expr_get_beam_index
	@ %def parton_expr_get_in_index
	@
	\subsection{Implementation for full events}
	This implementation contains the expressions that we can evaluate for the
	full event. It also contains data that pertain to the event, suitable
	for communication with external event formats. These data
	simultaneously serve as pointer targets for the variable lists hidden
	in the expressions (eval trees).

	Squared matrix element and weight values: when reading events from
	file, the [[ref]] value is the number in the file, while the [[prc]]
	value is the number that we calculate from the momenta in the file,
	possibly with different parameters. When generating events the first
	time, or if we do not recalculate, the numbers should coincide.
	Furthermore, the array of [[alt]] values is copied from an array of
	alternative event records. These values should represent calculated
	values.
	<<Subevt expr: public>>=
	public :: event_expr_t
	<<Subevt expr: types>>=
	type, extends (subevt_expr_t) :: event_expr_t
	logical :: has_reweight = .false.
	logical :: has_analysis = .false.
	class(expr_t), allocatable :: reweight
	class(expr_t), allocatable :: analysis
	logical :: has_id = .false.
	type(string_t) :: id
	logical :: has_num_id = .false.
	integer :: num_id = 0
	logical :: has_index = .false.
	integer :: index = 0
	logical :: has_sqme_ref = .false.
	real(default) :: sqme_ref = 0
	logical :: has_sqme_prc = .false.
	real(default) :: sqme_prc = 0
	logical :: has_weight_ref = .false.
	real(default) :: weight_ref = 0
	logical :: has_weight_prc = .false.
	real(default) :: weight_prc = 0
	logical :: has_excess_prc = .false.
	real(default) :: excess_prc = 0
	integer :: n_alt = 0
	logical :: has_sqme_alt = .false.
	real(default), dimension(:), allocatable :: sqme_alt
	logical :: has_weight_alt = .false.
	real(default), dimension(:), allocatable :: weight_alt
	contains
	<<Subevt expr: event expr: TBP>>
	end type event_expr_t

	@ %def event_expr_t
	@ Finalizer for the expressions.
	<<Subevt expr: event expr: TBP>>=
	procedure :: final => event_expr_final
	<<Subevt expr: sub interfaces>>=
	module subroutine event_expr_final (object)
	class(event_expr_t), intent(inout) :: object
	end subroutine event_expr_final
	<<Subevt expr: procedures>>=
	module subroutine event_expr_final (object)
	class(event_expr_t), intent(inout) :: object
	call object%base_final ()
	if (object%has_reweight) then
	call object%reweight%final ()
	end if
	if (object%has_analysis) then
	call object%analysis%final ()
	end if
	end subroutine event_expr_final

	@ %def event_expr_final
	@ Output: continue writing the active expressions, after the common selection
	expression.

	Note: the [[prefix]] argument is declared in the [[write]] method of the
	[[subevt_t]] base type. Here, it is unused.
	<<Subevt expr: event expr: TBP>>=
	procedure :: write => event_expr_write
	<<Subevt expr: sub interfaces>>=
	module subroutine event_expr_write (object, unit, prefix, pacified)
	class(event_expr_t), intent(in) :: object
	integer, intent(in), optional :: unit
	character(*), intent(in), optional :: prefix
	logical, intent(in), optional :: pacified
	end subroutine event_expr_write
	<<Subevt expr: procedures>>=
	module subroutine event_expr_write (object, unit, prefix, pacified)
	class(event_expr_t), intent(in) :: object
	integer, intent(in), optional :: unit
	character(*), intent(in), optional :: prefix
	logical, intent(in), optional :: pacified
	integer :: u
	u = given_output_unit (unit)
	call object%base_write (u, pacified = pacified)
	if (object%subevt_filled) then
	if (object%has_reweight) then
	call write_separator (u)
	write (u, "(1x,A)") "Reweighting expression:"
	call write_separator (u)
	call object%reweight%write (u)
	end if
	if (object%has_analysis) then
	call write_separator (u)
	write (u, "(1x,A)") "Analysis expression:"
	call write_separator (u)
	call object%analysis%write (u)
	end if
	end if
	end subroutine event_expr_write

	@ %def event_expr_write
	@ Initializer. This is required only for the [[sqme_alt]] and
	[[weight_alt]] arrays.
	<<Subevt expr: event expr: TBP>>=
	procedure :: init => event_expr_init
	<<Subevt expr: sub interfaces>>=
	module subroutine event_expr_init (expr, n_alt)
	class(event_expr_t), intent(out) :: expr
	integer, intent(in), optional :: n_alt
	end subroutine event_expr_init
	<<Subevt expr: procedures>>=
	module subroutine event_expr_init (expr, n_alt)
	class(event_expr_t), intent(out) :: expr
	integer, intent(in), optional :: n_alt
	if (present (n_alt)) then
	expr%n_alt = n_alt
	allocate (expr%sqme_alt (n_alt), source = 0._default)
	allocate (expr%weight_alt (n_alt), source = 0._default)
	end if
	end subroutine event_expr_init

	@ %def event_expr_init
	@ Define variables. We have the variables of the base type plus
	specific variables for full events. There is the event index.
	<<Subevt expr: event expr: TBP>>=
	procedure :: setup_vars => event_expr_setup_vars
	<<Subevt expr: sub interfaces>>=
	module subroutine event_expr_setup_vars (expr, sqrts)
	class(event_expr_t), intent(inout), target :: expr
	real(default), intent(in) :: sqrts
	end subroutine event_expr_setup_vars
	<<Subevt expr: procedures>>=
	module subroutine event_expr_setup_vars (expr, sqrts)
	class(event_expr_t), intent(inout), target :: expr
	real(default), intent(in) :: sqrts
	call expr%base_setup_vars (sqrts)
	call expr%var_list%append_string_ptr (var_str ("$process_id"), &
	expr%id, is_known = expr%has_id, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call expr%var_list%append_int_ptr (var_str ("process_num_id"), &
	expr%num_id, is_known = expr%has_num_id, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call expr%var_list%append_real_ptr (var_str ("sqme"), &
	expr%sqme_prc, is_known = expr%has_sqme_prc, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call expr%var_list%append_real_ptr (var_str ("sqme_ref"), &
	expr%sqme_ref, is_known = expr%has_sqme_ref, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call expr%var_list%append_int_ptr (var_str ("event_index"), &
	expr%index, is_known = expr%has_index, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call expr%var_list%append_real_ptr (var_str ("event_weight"), &
	expr%weight_prc, is_known = expr%has_weight_prc, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call expr%var_list%append_real_ptr (var_str ("event_weight_ref"), &
	expr%weight_ref, is_known = expr%has_weight_ref, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call expr%var_list%append_real_ptr (var_str ("event_excess"), &
	expr%excess_prc, is_known = expr%has_excess_prc, &
	locked = .true., verbose = .false., intrinsic = .true.)
	end subroutine event_expr_setup_vars

	@ %def event_expr_setup_vars
	@ Compile the analysis expression. If the pointer is disassociated, there is
	no expression.
	<<Subevt expr: event expr: TBP>>=
	procedure :: setup_analysis => event_expr_setup_analysis
	<<Subevt expr: sub interfaces>>=
	module subroutine event_expr_setup_analysis (expr, ef_analysis)
	class(event_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_analysis
	end subroutine event_expr_setup_analysis
	<<Subevt expr: procedures>>=
	module subroutine event_expr_setup_analysis (expr, ef_analysis)
	class(event_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_analysis
	call ef_analysis%build (expr%analysis)
	if (allocated (expr%analysis)) then
	call expr%setup_var_self ()
	call expr%analysis%setup_lexpr (expr%var_list)
	expr%has_analysis = .true.
	end if
	end subroutine event_expr_setup_analysis

	@ %def event_expr_setup_analysis
	@ Compile the reweight expression.
	<<Subevt expr: event expr: TBP>>=
	procedure :: setup_reweight => event_expr_setup_reweight
	<<Subevt expr: sub interfaces>>=
	module subroutine event_expr_setup_reweight (expr, ef_reweight)
	class(event_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_reweight
	end subroutine event_expr_setup_reweight
	<<Subevt expr: procedures>>=
	module subroutine event_expr_setup_reweight (expr, ef_reweight)
	class(event_expr_t), intent(inout), target :: expr
	class(expr_factory_t), intent(in) :: ef_reweight
	call ef_reweight%build (expr%reweight)
	if (allocated (expr%reweight)) then
	call expr%setup_var_self ()
	call expr%reweight%setup_expr (expr%var_list)
	expr%has_reweight = .true.
	end if
	end subroutine event_expr_setup_reweight

	@ %def event_expr_setup_reweight
	@ Store the string or numeric process ID. This should be done during
	initialization.
	<<Subevt expr: event expr: TBP>>=
	procedure :: set_process_id => event_expr_set_process_id
	procedure :: set_process_num_id => event_expr_set_process_num_id
	<<Subevt expr: sub interfaces>>=
	module subroutine event_expr_set_process_id (expr, id)
	class(event_expr_t), intent(inout) :: expr
	type(string_t), intent(in) :: id
	end subroutine event_expr_set_process_id
	module subroutine event_expr_set_process_num_id (expr, num_id)
	class(event_expr_t), intent(inout) :: expr
	integer, intent(in) :: num_id
	end subroutine event_expr_set_process_num_id
	<<Subevt expr: procedures>>=
	module subroutine event_expr_set_process_id (expr, id)
	class(event_expr_t), intent(inout) :: expr
	type(string_t), intent(in) :: id
	expr%id = id
	expr%has_id = .true.
	end subroutine event_expr_set_process_id

	module subroutine event_expr_set_process_num_id (expr, num_id)
	class(event_expr_t), intent(inout) :: expr
	integer, intent(in) :: num_id
	expr%num_id = num_id
	expr%has_num_id = .true.
	end subroutine event_expr_set_process_num_id

	@ %def event_expr_set_process_id
	@ %def event_expr_set_process_num_id
	@ Reset / set the data that pertain to a particular event. The event
	index is reset unless explicitly told to keep it.
	<<Subevt expr: event expr: TBP>>=
	procedure :: reset_contents => event_expr_reset_contents
	procedure :: set => event_expr_set
	<<Subevt expr: sub interfaces>>=
	module subroutine event_expr_reset_contents (expr)
	class(event_expr_t), intent(inout) :: expr
	end subroutine event_expr_reset_contents
	module subroutine event_expr_set (expr, &
	weight_ref, weight_prc, weight_alt, &
	excess_prc, &
	sqme_ref, sqme_prc, sqme_alt)
	class(event_expr_t), intent(inout) :: expr
	real(default), intent(in), optional :: weight_ref, weight_prc
	real(default), intent(in), optional :: excess_prc
	real(default), intent(in), optional :: sqme_ref, sqme_prc
	real(default), dimension(:), intent(in), optional :: sqme_alt, weight_alt
	end subroutine event_expr_set
	<<Subevt expr: procedures>>=
	module subroutine event_expr_reset_contents (expr)
	class(event_expr_t), intent(inout) :: expr
	call expr%base_reset_contents ()
	expr%has_sqme_ref = .false.
	expr%has_sqme_prc = .false.
	expr%has_sqme_alt = .false.
	expr%has_weight_ref = .false.
	expr%has_weight_prc = .false.
	expr%has_weight_alt = .false.
	expr%has_excess_prc = .false.
	end subroutine event_expr_reset_contents

	module subroutine event_expr_set (expr, &
	weight_ref, weight_prc, weight_alt, &
	excess_prc, &
	sqme_ref, sqme_prc, sqme_alt)
	class(event_expr_t), intent(inout) :: expr
	real(default), intent(in), optional :: weight_ref, weight_prc
	real(default), intent(in), optional :: excess_prc
	real(default), intent(in), optional :: sqme_ref, sqme_prc
	real(default), dimension(:), intent(in), optional :: sqme_alt, weight_alt
	if (present (sqme_ref)) then
	expr%has_sqme_ref = .true.
	expr%sqme_ref = sqme_ref
	end if
	if (present (sqme_prc)) then
	expr%has_sqme_prc = .true.
	expr%sqme_prc = sqme_prc
	end if
	if (present (sqme_alt)) then
	expr%has_sqme_alt = .true.
	expr%sqme_alt = sqme_alt
	end if
	if (present (weight_ref)) then
	expr%has_weight_ref = .true.
	expr%weight_ref = weight_ref
	end if
	if (present (weight_prc)) then
	expr%has_weight_prc = .true.
	expr%weight_prc = weight_prc
	end if
	if (present (weight_alt)) then
	expr%has_weight_alt = .true.
	expr%weight_alt = weight_alt
	end if
	if (present (excess_prc)) then
	expr%has_excess_prc = .true.
	expr%excess_prc = excess_prc
	end if
	end subroutine event_expr_set

	@ %def event_expr_reset_contents event_expr_set
	@ Access the subevent index.
	<<Subevt expr: event expr: TBP>>=
	procedure :: has_event_index => event_expr_has_event_index
	procedure :: get_event_index => event_expr_get_event_index
	<<Subevt expr: sub interfaces>>=
	module function event_expr_has_event_index (expr) result (flag)
	class(event_expr_t), intent(in) :: expr
	logical :: flag
	end function event_expr_has_event_index
	module function event_expr_get_event_index (expr) result (index)
	class(event_expr_t), intent(in) :: expr
	integer :: index
	end function event_expr_get_event_index
	<<Subevt expr: procedures>>=
	module function event_expr_has_event_index (expr) result (flag)
	class(event_expr_t), intent(in) :: expr
	logical :: flag
	flag = expr%has_index
	end function event_expr_has_event_index

	module function event_expr_get_event_index (expr) result (index)
	class(event_expr_t), intent(in) :: expr
	integer :: index
	if (expr%has_index) then
	index = expr%index
	else
	index = 0
	end if
	end function event_expr_get_event_index

	@ %def event_expr_has_event_index
	@ %def event_expr_get_event_index
	@ Set/increment the subevent index. Initialize it if necessary.
	<<Subevt expr: event expr: TBP>>=
	procedure :: set_event_index => event_expr_set_event_index
	procedure :: reset_event_index => event_expr_reset_event_index
	procedure :: increment_event_index => event_expr_increment_event_index
	<<Subevt expr: sub interfaces>>=
	module subroutine event_expr_set_event_index (expr, index)
	class(event_expr_t), intent(inout) :: expr
	integer, intent(in) :: index
	end subroutine event_expr_set_event_index
	module subroutine event_expr_reset_event_index (expr)
	class(event_expr_t), intent(inout) :: expr
	end subroutine event_expr_reset_event_index
	module subroutine event_expr_increment_event_index (expr, offset)
	class(event_expr_t), intent(inout) :: expr
	integer, intent(in), optional :: offset
	end subroutine event_expr_increment_event_index
	<<Subevt expr: procedures>>=
	module subroutine event_expr_set_event_index (expr, index)
	class(event_expr_t), intent(inout) :: expr
	integer, intent(in) :: index
	expr%index = index
	expr%has_index = .true.
	end subroutine event_expr_set_event_index

	module subroutine event_expr_reset_event_index (expr)
	class(event_expr_t), intent(inout) :: expr
	expr%has_index = .false.
	end subroutine event_expr_reset_event_index

	module subroutine event_expr_increment_event_index (expr, offset)
	class(event_expr_t), intent(inout) :: expr
	integer, intent(in), optional :: offset
	if (expr%has_index) then
	expr%index = expr%index + 1
	else if (present (offset)) then
	call expr%set_event_index (offset + 1)
	else
	call expr%set_event_index (1)
	end if
	end subroutine event_expr_increment_event_index

	@ %def event_expr_set_event_index
	@ %def event_expr_increment_event_index
	@ Fill the event expression: take the particle data and kinematics
	from a [[particle_set]] object.

	We allow the particle content to change for each event. Therefore, we set the
	event variables each time.

	Also increment the event index; initialize it if necessary.
	<<Subevt expr: event expr: TBP>>=
	procedure :: fill_subevt => event_expr_fill_subevt
	<<Subevt expr: sub interfaces>>=
	module subroutine event_expr_fill_subevt (expr, particle_set)
	class(event_expr_t), intent(inout) :: expr
	type(particle_set_t), intent(in) :: particle_set
	end subroutine event_expr_fill_subevt
	<<Subevt expr: procedures>>=
	module subroutine event_expr_fill_subevt (expr, particle_set)
	class(event_expr_t), intent(inout) :: expr
	type(particle_set_t), intent(in) :: particle_set
	call particle_set%to_subevt (expr%subevt_t, expr%colorize_subevt)
	expr%sqrts_hat = expr%get_sqrts_hat ()
	expr%n_in = expr%get_n_in ()
	expr%n_out = expr%get_n_out ()
	expr%n_tot = expr%n_in + expr%n_out
	expr%subevt_filled = .true.
	end subroutine event_expr_fill_subevt

	@ %def event_expr_fill_subevt
	@ Evaluate, if the event passes the selection. For absent expressions we take
	default values.
	<<Subevt expr: event expr: TBP>>=
	procedure :: evaluate => event_expr_evaluate
	<<Subevt expr: sub interfaces>>=
	module subroutine event_expr_evaluate &
	(expr, passed, reweight, analysis_flag)
	class(event_expr_t), intent(inout) :: expr
	logical, intent(out) :: passed
	real(default), intent(out) :: reweight
	logical, intent(out) :: analysis_flag
	end subroutine event_expr_evaluate
	<<Subevt expr: procedures>>=
	module subroutine event_expr_evaluate (expr, passed, reweight, analysis_flag)
	class(event_expr_t), intent(inout) :: expr
	logical, intent(out) :: passed
	real(default), intent(out) :: reweight
	logical, intent(out) :: analysis_flag
	call expr%base_evaluate (passed)
	if (passed) then
	if (expr%has_reweight) then
	call expr%reweight%evaluate ()
	if (expr%reweight%is_known ()) then
	reweight = expr%reweight%get_real ()
	else
	call msg_error ("Evaluate reweight expression: &
	&result undefined")
	reweight = 0
	end if
	else
	reweight = 1
	end if
	if (expr%has_analysis) then
	call expr%analysis%evaluate ()
	if (expr%analysis%is_known ()) then
	analysis_flag = expr%analysis%get_log ()
	else
	call msg_error ("Evaluate analysis expression: &
	&result undefined")
	analysis_flag = .false.
	end if
	else
	analysis_flag = .true.
	end if
	end if
	end subroutine event_expr_evaluate

	@ %def event_expr_evaluate
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Parton states}
	A [[parton_state_t]] object contains the effective kinematics and
	dynamics of an elementary partonic interaction, with or without the
	beam/structure function state included. The type is abstract and has
	two distinct extensions. The [[isolated_state_t]] extension describes
	the isolated elementary interaction where the [[int_eff]] subobject
	contains the complex transition amplitude, exclusive in all quantum
	numbers. The particle content and kinematics describe the effective
	partonic state. The [[connected_state_t]] extension contains the
	partonic [[subevt]] and the expressions for cuts and scales which use
	it.

	In the isolated state, the effective partonic interaction may either
	be identical to the hard interaction, in which case it is just a
	pointer to the latter. Or it may involve a rearrangement of partons,
	in which case we allocate it explicitly and flag this by
	[[int_is_allocated]].

	The [[trace]] evaluator contains the absolute square of the effective
	transition amplitude matrix, summed over final states. It is also summed over
	initial states, depending on the the beam setup allows. The result is used for
	integration.

	The [[matrix]] evaluator is the counterpart of [[trace]] which is kept
	exclusive in all observable quantum numbers. The [[flows]] evaluator is
	furthermore exclusive in colors, but neglecting all color interference. The
	[[matrix]] and [[flows]] evaluators are filled only for sampling points that
	become part of physical events.

	Note: It would be natural to make the evaluators allocatable. The extra
	[[has_XXX]] flags indicate whether evaluators are active, instead.

	This module contains no unit tests. The tests are covered by the
	[[processes]] module below.
	<<[[parton_states.f90]]>>=
	<<File header>>
	module parton_states

	<<Use kinds>>
	use variables
	use expr_base
	use model_data
	use flavors
	use quantum_numbers
	use state_matrices
	use interactions
	use evaluators

	use beams
	use sf_base
	use prc_core
	use subevt_expr

	<<Standard module head>>

	<<Parton states: public>>

	<<Parton states: types>>

	interface
	<<Parton states: sub interfaces>>
	end interface

	end module parton_states
	@ %def parton_states
	@
	<<[[parton_states_sub.f90]]>>=
	<<File header>>

	submodule (parton_states) parton_states_s

	<<Use debug>>
	use io_units
	use format_utils, only: write_separator
	use diagnostics
	use lorentz
	use subevents
	use helicities
	use colors
	use polarizations
	use process_constants

	implicit none

	contains

	<<Parton states: procedures>>

	end submodule parton_states_s

	@ %def parton_states_s
	@
	\subsection{Abstract base type}
	The common part are the evaluators, one for the trace (summed over all
	quantum numbers), one for the transition matrix (summed only over
	unobservable quantum numbers), and one for the flow distribution
	(transition matrix without interferences, exclusive in color flow).
	<<Parton states: types>>=
	type, abstract :: parton_state_t
	logical :: has_trace = .false.
	logical :: has_matrix = .false.
	logical :: has_flows = .false.
	type(evaluator_t) :: trace
	type(evaluator_t) :: matrix
	type(evaluator_t) :: flows
	contains
	<<Parton states: parton state: TBP>>
	end type parton_state_t

	@ %def parton_state_t
	@ The [[isolated_state_t]] extension contains the [[sf_chain_eff]] object
	and the (hard) effective interaction [[int_eff]], separately, both are
	implemented as a pointer. The evaluators (trace, matrix, flows) apply
	to the hard interaction only.

	If the effective interaction differs from the hard interaction, the
	pointer is allocated explicitly. Analogously for [[sf_chain_eff]].
	<<Parton states: public>>=
	public :: isolated_state_t
	<<Parton states: types>>=
	type, extends (parton_state_t) :: isolated_state_t
	logical :: sf_chain_is_allocated = .false.
	type(sf_chain_instance_t), pointer :: sf_chain_eff => null ()
	logical :: int_is_allocated = .false.
	type(interaction_t), pointer :: int_eff => null ()
	contains
	<<Parton states: isolated state: TBP>>
	end type isolated_state_t

	@ %def isolated_state_t
	@ The [[connected_state_t]] extension contains all data that enable
	the evaluation of observables for the effective connected state. The
	evaluators connect the (effective) structure-function chain and hard
	interaction that were kept separate in the [[isolated_state_t]].

	The [[flows_sf]] evaluator is an extended copy of the
	structure-function

	The [[expr]] subobject consists of the [[subevt]], a simple event record,
	expressions for cuts etc.\ which refer to this record, and a [[var_list]]
	which contains event-specific variables, linked to the process variable
	list. Variables used within the expressions are looked up in [[var_list]].
	<<Parton states: public>>=
	public :: connected_state_t
	<<Parton states: types>>=
	type, extends (parton_state_t) :: connected_state_t
	type(state_flv_content_t) :: state_flv
	logical :: has_flows_sf = .false.
	type(evaluator_t) :: flows_sf
	logical :: has_expr = .false.
	type(parton_expr_t) :: expr
	contains
	<<Parton states: connected state: TBP>>
	end type connected_state_t

	@ %def connected_state_t
	@ Output: each evaluator is written only when it is active. The
	[[sf_chain]] is only written if it is explicitly allocated.
	<<Parton states: parton state: TBP>>=
	procedure :: write => parton_state_write
	<<Parton states: sub interfaces>>=
	module subroutine parton_state_write (state, unit, testflag)
	class(parton_state_t), intent(in) :: state
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine parton_state_write
	<<Parton states: procedures>>=
	module subroutine parton_state_write (state, unit, testflag)
	class(parton_state_t), intent(in) :: state
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	select type (state)
	class is (isolated_state_t)
	if (state%sf_chain_is_allocated) then
	call write_separator (u)
	call state%sf_chain_eff%write (u)
	end if
	if (state%int_is_allocated) then
	call write_separator (u)
	write (u, "(1x,A)") &
	"Effective interaction:"
	call write_separator (u)
	call state%int_eff%basic_write (u, testflag = testflag)
	end if
	class is (connected_state_t)
	if (state%has_flows_sf) then
	call write_separator (u)
	write (u, "(1x,A)") &
	"Evaluator (extension of the beam evaluator &
	&with color contractions):"
	call write_separator (u)
	call state%flows_sf%write (u, testflag = testflag)
	end if
	end select
	if (state%has_trace) then
	call write_separator (u)
	write (u, "(1x,A)") &
	"Evaluator (trace of the squared transition matrix):"
	call write_separator (u)
	call state%trace%write (u, testflag = testflag)
	end if
	if (state%has_matrix) then
	call write_separator (u)
	write (u, "(1x,A)") &
	"Evaluator (squared transition matrix):"
	call write_separator (u)
	call state%matrix%write (u, testflag = testflag)
	end if
	if (state%has_flows) then
	call write_separator (u)
	write (u, "(1x,A)") &
	"Evaluator (squared color-flow matrix):"
	call write_separator (u)
	call state%flows%write (u, testflag = testflag)
	end if
	select type (state)
	class is (connected_state_t)
	if (state%has_expr) then
	call write_separator (u)
	call state%expr%write (u)
	end if
	end select
	end subroutine parton_state_write

	@ %def parton_state_write
	@ Finalize interaction and evaluators, but only if allocated.
	<<Parton states: parton state: TBP>>=
	procedure :: final => parton_state_final
	<<Parton states: sub interfaces>>=
	module subroutine parton_state_final (state)
	class(parton_state_t), intent(inout) :: state
	end subroutine parton_state_final
	<<Parton states: procedures>>=
	module subroutine parton_state_final (state)
	class(parton_state_t), intent(inout) :: state
	if (state%has_flows) then
	call state%flows%final ()
	state%has_flows = .false.
	end if
	if (state%has_matrix) then
	call state%matrix%final ()
	state%has_matrix = .false.
	end if
	if (state%has_trace) then
	call state%trace%final ()
	state%has_trace = .false.
	end if
	select type (state)
	class is (connected_state_t)
	if (state%has_flows_sf) then
	call state%flows_sf%final ()
	state%has_flows_sf = .false.
	end if
	call state%expr%final ()
	class is (isolated_state_t)
	if (state%int_is_allocated) then
	call state%int_eff%final ()
	deallocate (state%int_eff)
	state%int_is_allocated = .false.
	end if
	if (state%sf_chain_is_allocated) then
	call state%sf_chain_eff%final ()
	end if
	end select
	end subroutine parton_state_final

	@ %def parton_state_final
	@
	\subsection{Common Initialization}
	Initialize the isolated parton state. In this version, the
	effective structure-function chain [[sf_chain_eff]] and the effective
	interaction [[int_eff]] both are trivial pointers to the seed
	structure-function chain and to the hard interaction, respectively.
	<<Parton states: isolated state: TBP>>=
	procedure :: init => isolated_state_init
	<<Parton states: sub interfaces>>=
	module subroutine isolated_state_init (state, sf_chain, int)
	class(isolated_state_t), intent(out) :: state
	type(sf_chain_instance_t), intent(in), target :: sf_chain
	type(interaction_t), intent(in), target :: int
	end subroutine isolated_state_init
	<<Parton states: procedures>>=
	module subroutine isolated_state_init (state, sf_chain, int)
	class(isolated_state_t), intent(out) :: state
	type(sf_chain_instance_t), intent(in), target :: sf_chain
	type(interaction_t), intent(in), target :: int
	state%sf_chain_eff => sf_chain
	state%int_eff => int
	end subroutine isolated_state_init

	@ %def isolated_state_init
	@
	\subsection{Evaluator initialization: isolated state}
	Create an evaluator for the trace of the squared transition matrix.
	The trace goes over all outgoing quantum numbers. Whether we trace
	over incoming quantum numbers other than color, depends on the given
	[[qn_mask_in]].

	There are two options: explicitly computing the color factor table
	([[use_cf]] false; [[nc]] defined), or taking the color factor
	table from the hard matrix element data.
	<<Parton states: isolated state: TBP>>=
	procedure :: setup_square_trace => isolated_state_setup_square_trace
	<<Parton states: sub interfaces>>=
	module subroutine isolated_state_setup_square_trace (state, core, &
	qn_mask_in, col, keep_fs_flavor)
	class(isolated_state_t), intent(inout), target :: state
	class(prc_core_t), intent(in) :: core
	type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
	integer, intent(in), dimension(:), allocatable :: col
	logical, intent(in) :: keep_fs_flavor
	end subroutine isolated_state_setup_square_trace
	<<Parton states: procedures>>=
	module subroutine isolated_state_setup_square_trace (state, core, &
	qn_mask_in, col, keep_fs_flavor)
	class(isolated_state_t), intent(inout), target :: state
	class(prc_core_t), intent(in) :: core
	type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
	!!! Actually need allocatable attribute here for once because col might
	!!! enter the subroutine non-allocated.
	integer, intent(in), dimension(:), allocatable :: col
	logical, intent(in) :: keep_fs_flavor
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
	associate (data => core%data)
	allocate (qn_mask (data%n_in + data%n_out))
	qn_mask( : data%n_in) = &
	quantum_numbers_mask (.false., .true., .false.) &
	.or. qn_mask_in
	qn_mask(data%n_in + 1 : ) = &
	quantum_numbers_mask (.not. keep_fs_flavor, .true., .true.)
	if (core%use_color_factors) then
	call state%trace%init_square (state%int_eff, qn_mask, &
	col_flow_index = data%cf_index, &
	col_factor = data%color_factors, &
	col_index_hi = col, &
	nc = core%nc)
	else
	call state%trace%init_square (state%int_eff, qn_mask, nc = core%nc)
	end if
	end associate
	state%has_trace = .true.
	end subroutine isolated_state_setup_square_trace

	@ %def isolated_state_setup_square_trace
	@ Set up an identity-evaluator for the trace. This implies that [[me]]
	is considered to be a squared amplitude, as for example for BLHA matrix
	elements.
	<<Parton states: isolated state: TBP>>=
	procedure :: setup_identity_trace => isolated_state_setup_identity_trace
	<<Parton states: sub interfaces>>=
	module subroutine isolated_state_setup_identity_trace (state, core, &
	qn_mask_in, keep_fs_flavors, keep_colors)
	class(isolated_state_t), intent(inout), target :: state
	class(prc_core_t), intent(in) :: core
	type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
	logical, intent(in), optional :: keep_fs_flavors, keep_colors
	end subroutine isolated_state_setup_identity_trace
	<<Parton states: procedures>>=
	module subroutine isolated_state_setup_identity_trace (state, core, &
	qn_mask_in, keep_fs_flavors, keep_colors)
	class(isolated_state_t), intent(inout), target :: state
	class(prc_core_t), intent(in) :: core
	type(quantum_numbers_mask_t), intent(in), dimension(:) :: qn_mask_in
	logical, intent(in), optional :: keep_fs_flavors, keep_colors
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
	logical :: fs_flv_flag, col_flag
	fs_flv_flag = .true.; col_flag = .true.
	if (present(keep_fs_flavors)) fs_flv_flag = .not. keep_fs_flavors
	if (present(keep_colors)) col_flag = .not. keep_colors
	associate (data => core%data)
	allocate (qn_mask (data%n_in + data%n_out))
	qn_mask( : data%n_in) = &
	quantum_numbers_mask (.false., col_flag, .false.) .or. qn_mask_in
	qn_mask(data%n_in + 1 : ) = &
	quantum_numbers_mask (fs_flv_flag, col_flag, .true.)
	end associate
	call state%int_eff%set_mask (qn_mask)
	call state%trace%init_identity (state%int_eff)
	state%has_trace = .true.
	end subroutine isolated_state_setup_identity_trace

	@ %def isolated_state_setup_identity_trace
	@ Set up the evaluator for the transition matrix, exclusive in
	helicities where this is requested.

	For all unstable final-state particles we keep polarization according to the
	applicable decay options. If the process is a decay itself, this applies also
	to the initial state.

	For all polarized final-state particles, we keep polarization including
	off-diagonal entries. We drop helicity completely for unpolarized final-state
	particles.

	For the initial state, if the particle has not been handled yet, we
	apply the provided [[qn_mask_in]] which communicates the beam properties.
	<<Parton states: isolated state: TBP>>=
	procedure :: setup_square_matrix => isolated_state_setup_square_matrix
	<<Parton states: sub interfaces>>=
	module subroutine isolated_state_setup_square_matrix &
	(state, core, model, qn_mask_in, col)
	class(isolated_state_t), intent(inout), target :: state
	class(prc_core_t), intent(in) :: core
	class(model_data_t), intent(in), target :: model
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
	integer, dimension(:), intent(in) :: col
	end subroutine isolated_state_setup_square_matrix
	<<Parton states: procedures>>=
	module subroutine isolated_state_setup_square_matrix &
	(state, core, model, qn_mask_in, col)
	class(isolated_state_t), intent(inout), target :: state
	class(prc_core_t), intent(in) :: core
	class(model_data_t), intent(in), target :: model
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
	integer, dimension(:), intent(in) :: col
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: i
	logical :: helmask, helmask_hd
	associate (data => core%data)
	allocate (qn_mask (data%n_in + data%n_out))
	allocate (flv (data%n_flv))
	do i = 1, data%n_in + data%n_out
	call flv%init (data%flv_state(i,:), model)
	if ((data%n_in == 1 .or. i > data%n_in) &
	.and. any (.not. flv%is_stable ())) then
	helmask = all (flv%decays_isotropically ())
	helmask_hd = all (flv%decays_diagonal ())
	qn_mask(i) = quantum_numbers_mask (.false., .true., helmask, &
	mask_hd = helmask_hd)
	else if (i > data%n_in) then
	helmask = all (.not. flv%is_polarized ())
	qn_mask(i) = quantum_numbers_mask (.false., .true., helmask)
	else
	qn_mask(i) = quantum_numbers_mask (.false., .true., .false.) &
	.or. qn_mask_in(i)
	end if
	end do
	if (core%use_color_factors) then
	call state%matrix%init_square (state%int_eff, qn_mask, &
	col_flow_index = data%cf_index, &
	col_factor = data%color_factors, &
	col_index_hi = col, &
	nc = core%nc)
	else
	call state%matrix%init_square (state%int_eff, &
	qn_mask, &
	nc = core%nc)
	end if
	end associate
	state%has_matrix = .true.
	end subroutine isolated_state_setup_square_matrix

	@ %def isolated_state_setup_square_matrix
	@ This procedure initializes the evaluator that computes the
	contributions to color flows, neglecting color interference.
	The incoming-particle mask can be used to sum over incoming flavor.

	Helicity handling: see above.
	<<Parton states: isolated state: TBP>>=
	procedure :: setup_square_flows => isolated_state_setup_square_flows
	<<Parton states: sub interfaces>>=
	module subroutine isolated_state_setup_square_flows &
	(state, core, model, qn_mask_in)
	class(isolated_state_t), intent(inout), target :: state
	class(prc_core_t), intent(in) :: core
	class(model_data_t), intent(in), target :: model
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
	end subroutine isolated_state_setup_square_flows
	<<Parton states: procedures>>=
	module subroutine isolated_state_setup_square_flows &
	(state, core, model, qn_mask_in)
	class(isolated_state_t), intent(inout), target :: state
	class(prc_core_t), intent(in) :: core
	class(model_data_t), intent(in), target :: model
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: i
	logical :: helmask, helmask_hd
	associate (data => core%data)
	allocate (qn_mask (data%n_in + data%n_out))
	allocate (flv (data%n_flv))
	do i = 1, data%n_in + data%n_out
	call flv%init (data%flv_state(i,:), model)
	if ((data%n_in == 1 .or. i > data%n_in) &
	.and. any (.not. flv%is_stable ())) then
	helmask = all (flv%decays_isotropically ())
	helmask_hd = all (flv%decays_diagonal ())
	qn_mask(i) = quantum_numbers_mask (.false., .false., helmask, &
	mask_hd = helmask_hd)
	else if (i > data%n_in) then
	helmask = all (.not. flv%is_polarized ())
	qn_mask(i) = quantum_numbers_mask (.false., .false., helmask)
	else
	qn_mask(i) = quantum_numbers_mask (.false., .false., .false.) &
	.or. qn_mask_in(i)
	end if
	end do
	call state%flows%init_square (state%int_eff, qn_mask, &
	expand_color_flows = .true.)
	end associate
	state%has_flows = .true.
	end subroutine isolated_state_setup_square_flows

	@ %def isolated_state_setup_square_flows
	@
	\subsection{Evaluator initialization: connected state}
	Set up a trace evaluator as a product of two evaluators (incoming state,
	effective interaction). In the result, all quantum numbers are summed over.

	If the optional [[int]] interaction is provided, use this for the
	first factor in the convolution. Otherwise, use the final interaction
	of the stored [[sf_chain]].

	The [[resonant]] flag applies if we want to construct
	a decay chain. The resonance property can propagate to the final
	event output.

	If an extended structure function is required [[requires_extended_sf]],
	we have to not consider [[sub]] as a quantum number.
	<<Parton states: connected state: TBP>>=
	procedure :: setup_connected_trace => connected_state_setup_connected_trace
	<<Parton states: sub interfaces>>=
	module subroutine connected_state_setup_connected_trace &
	(state, isolated, int, resonant, undo_helicities, &
	keep_fs_flavors, requires_extended_sf)
	class(connected_state_t), intent(inout), target :: state
	type(isolated_state_t), intent(in), target :: isolated
	type(interaction_t), intent(in), optional, target :: int
	logical, intent(in), optional :: resonant
	logical, intent(in), optional :: undo_helicities
	logical, intent(in), optional :: keep_fs_flavors
	logical, intent(in), optional :: requires_extended_sf
	end subroutine connected_state_setup_connected_trace
	<<Parton states: procedures>>=
	module subroutine connected_state_setup_connected_trace &
	(state, isolated, int, resonant, undo_helicities, &
	keep_fs_flavors, requires_extended_sf)
	class(connected_state_t), intent(inout), target :: state
	type(isolated_state_t), intent(in), target :: isolated
	type(interaction_t), intent(in), optional, target :: int
	logical, intent(in), optional :: resonant
	logical, intent(in), optional :: undo_helicities
	logical, intent(in), optional :: keep_fs_flavors
	logical, intent(in), optional :: requires_extended_sf
	type(quantum_numbers_mask_t) :: mask
	type(interaction_t), pointer :: src_int, beam_int
	logical :: reduce, fs_flv_flag
	if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, &
	"connected_state_setup_connected_trace")
	reduce = .false.; fs_flv_flag = .true.
	if (present (undo_helicities)) reduce = undo_helicities
	if (present (keep_fs_flavors)) fs_flv_flag = .not. keep_fs_flavors
	mask = quantum_numbers_mask (fs_flv_flag, .true., .true.)
	if (present (int)) then
	src_int => int
	else
	src_int => isolated%sf_chain_eff%get_out_int_ptr ()
	end if

	if (debug2_active (D_PROCESS_INTEGRATION)) then
	call src_int%basic_write ()
	end if

	call state%trace%init_product (src_int, isolated%trace, &
	qn_mask_conn = mask, &
	qn_mask_rest = mask, &
	connections_are_resonant = resonant, &
	ignore_sub_for_qn = requires_extended_sf)

	if (reduce) then
	beam_int => isolated%sf_chain_eff%get_beam_int_ptr ()
	call undo_qn_hel (beam_int, mask, beam_int%get_n_tot ())
	call undo_qn_hel (src_int, mask, src_int%get_n_tot ())
	call beam_int%set_matrix_element (cmplx (1, 0, default))
	call src_int%set_matrix_element (cmplx (1, 0, default))
	end if

	state%has_trace = .true.
	contains
	subroutine undo_qn_hel (int_in, mask, n_tot)
	type(interaction_t), intent(inout) :: int_in
	type(quantum_numbers_mask_t), intent(in) :: mask
	integer, intent(in) :: n_tot
	type(quantum_numbers_mask_t), dimension(n_tot) :: mask_in
	mask_in = mask
	call int_in%set_mask (mask_in)
	end subroutine undo_qn_hel
	end subroutine connected_state_setup_connected_trace

	@ %def connected_state_setup_connected_trace
	@ Set up a matrix evaluator as a product of two evaluators (incoming
	state, effective interation). In the intermediate state, color and
	helicity is summed over. In the final state, we keep the quantum
	numbers which are present in the original evaluators.
	<<Parton states: connected state: TBP>>=
	procedure :: setup_connected_matrix => connected_state_setup_connected_matrix
	<<Parton states: sub interfaces>>=
	module subroutine connected_state_setup_connected_matrix &
	(state, isolated, int, resonant, qn_filter_conn)
	class(connected_state_t), intent(inout), target :: state
	type(isolated_state_t), intent(in), target :: isolated
	type(interaction_t), intent(in), optional, target :: int
	logical, intent(in), optional :: resonant
	type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
	end subroutine connected_state_setup_connected_matrix
	<<Parton states: procedures>>=
	module subroutine connected_state_setup_connected_matrix &
	(state, isolated, int, resonant, qn_filter_conn)
	class(connected_state_t), intent(inout), target :: state
	type(isolated_state_t), intent(in), target :: isolated
	type(interaction_t), intent(in), optional, target :: int
	logical, intent(in), optional :: resonant
	type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
	type(quantum_numbers_mask_t) :: mask
	type(interaction_t), pointer :: src_int
	mask = quantum_numbers_mask (.false., .true., .true.)
	if (present (int)) then
	src_int => int
	else
	src_int => isolated%sf_chain_eff%get_out_int_ptr ()
	end if
	call state%matrix%init_product &
	(src_int, isolated%matrix, mask, &
	qn_filter_conn = qn_filter_conn, &
	connections_are_resonant = resonant)
	state%has_matrix = .true.
	end subroutine connected_state_setup_connected_matrix

	@ %def connected_state_setup_connected_matrix
	@ Set up a matrix evaluator as a product of two evaluators (incoming
	state, effective interation). In the intermediate state, only
	helicity is summed over. In the final state, we keep the quantum
	numbers which are present in the original evaluators.


	If the optional [[int]] interaction is provided, use this for the
	first factor in the convolution. Otherwise, use the final interaction
	of the stored [[sf_chain]], after creating an intermediate interaction
	that includes a correlated color state. We assume that for a
	caller-provided [[int]], this is not necessary.

	For fixed-order NLO differential distribution, we are interested at
	the partonic level, no parton showering takes place as this would
	demand for a proper matching. So, the flows in the [[connected_state]]
	are not needed, and the color part will be masked for the interaction
	coming from the [[sf_chain]]. The squared matrix elements coming from
	the OLP provider at the moment do not come with flows anyhow. This
	needs to be revised once the matching to the shower is completed.
	<<Parton states: connected state: TBP>>=
	procedure :: setup_connected_flows => connected_state_setup_connected_flows
	<<Parton states: sub interfaces>>=
	module subroutine connected_state_setup_connected_flows &
	(state, isolated, int, resonant, qn_filter_conn, mask_color)
	class(connected_state_t), intent(inout), target :: state
	type(isolated_state_t), intent(in), target :: isolated
	type(interaction_t), intent(in), optional, target :: int
	logical, intent(in), optional :: resonant, mask_color
	type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
	end subroutine connected_state_setup_connected_flows
	<<Parton states: procedures>>=
	module subroutine connected_state_setup_connected_flows &
	(state, isolated, int, resonant, qn_filter_conn, mask_color)
	class(connected_state_t), intent(inout), target :: state
	type(isolated_state_t), intent(in), target :: isolated
	type(interaction_t), intent(in), optional, target :: int
	logical, intent(in), optional :: resonant, mask_color
	type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
	type(quantum_numbers_mask_t) :: mask
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask_sf
	type(interaction_t), pointer :: src_int
	logical :: mask_c
	mask_c = .false.
	if (present (mask_color)) mask_c = mask_color
	mask = quantum_numbers_mask (.false., .false., .true.)
	if (present (int)) then
	src_int => int
	else
	src_int => isolated%sf_chain_eff%get_out_int_ptr ()
	call state%flows_sf%init_color_contractions (src_int)
	state%has_flows_sf = .true.
	src_int => state%flows_sf%interaction_t
	if (mask_c) then
	allocate (mask_sf (src_int%get_n_tot ()))
	mask_sf = quantum_numbers_mask (.false., .true., .false.)
	call src_int%reduce_state_matrix (mask_sf, keep_order = .true.)
	end if
	end if
	call state%flows%init_product (src_int, isolated%flows, mask, &
	qn_filter_conn = qn_filter_conn, &
	connections_are_resonant = resonant)
	state%has_flows = .true.
	end subroutine connected_state_setup_connected_flows

	@ %def connected_state_setup_connected_flows
	@ Determine and store the flavor content for the connected state.
	This queries the [[matrix]] evaluator component, which should hold the
	requested flavor information.
	<<Parton states: connected state: TBP>>=
	procedure :: setup_state_flv => connected_state_setup_state_flv
	<<Parton states: sub interfaces>>=
	module subroutine connected_state_setup_state_flv (state, n_out_hard)
	class(connected_state_t), intent(inout), target :: state
	integer, intent(in) :: n_out_hard
	end subroutine connected_state_setup_state_flv
	<<Parton states: procedures>>=
	module subroutine connected_state_setup_state_flv (state, n_out_hard)
	class(connected_state_t), intent(inout), target :: state
	integer, intent(in) :: n_out_hard
	call state%matrix%get_flv_content (state%state_flv, n_out_hard)
	end subroutine connected_state_setup_state_flv

	@ %def connected_state_setup_state_flv
	@ Return the current flavor state object.
	<<Parton states: connected state: TBP>>=
	procedure :: get_state_flv => connected_state_get_state_flv
	<<Parton states: sub interfaces>>=
	module function connected_state_get_state_flv (state) result (state_flv)
	class(connected_state_t), intent(in) :: state
	type(state_flv_content_t) :: state_flv
	end function connected_state_get_state_flv
	<<Parton states: procedures>>=
	module function connected_state_get_state_flv (state) result (state_flv)
	class(connected_state_t), intent(in) :: state
	type(state_flv_content_t) :: state_flv
	state_flv = state%state_flv
	end function connected_state_get_state_flv

	@ %def connected_state_get_state_flv
	@
	\subsection{Cuts and expressions}
	Set up the [[subevt]] that corresponds to the connected interaction.
	The index arrays refer to the interaction.

	We assign the particles as follows: the beam particles are the first
	two (decay process: one) entries in the trace evaluator. The incoming
	partons are identified by their link to the outgoing partons of the
	structure-function chain. The outgoing partons are those of the trace
	evaluator, which include radiated partons during the
	structure-function chain.
	<<Parton states: connected state: TBP>>=
	procedure :: setup_subevt => connected_state_setup_subevt
	<<Parton states: sub interfaces>>=
	module subroutine connected_state_setup_subevt &
	(state, sf_chain, f_beam, f_in, f_out)
	class(connected_state_t), intent(inout), target :: state
	type(sf_chain_instance_t), intent(in), target :: sf_chain
	type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
	end subroutine connected_state_setup_subevt
	<<Parton states: procedures>>=
	module subroutine connected_state_setup_subevt &
	(state, sf_chain, f_beam, f_in, f_out)
	class(connected_state_t), intent(inout), target :: state
	type(sf_chain_instance_t), intent(in), target :: sf_chain
	type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
	integer :: n_beam, n_in, n_out, n_vir, n_tot, i, j
	integer, dimension(:), allocatable :: i_beam, i_in, i_out
	integer :: sf_out_i
	type(interaction_t), pointer :: sf_int
	sf_int => sf_chain%get_out_int_ptr ()
	n_beam = size (f_beam)
	n_in = size (f_in)
	n_out = size (f_out)
	n_vir = state%trace%get_n_vir ()
	n_tot = state%trace%get_n_tot ()
	allocate (i_beam (n_beam), i_in (n_in), i_out (n_out))
	i_beam = [(i, i = 1, n_beam)]
	do j = 1, n_in
	sf_out_i = sf_chain%get_out_i (j)
	i_in(j) = interaction_find_link &
	(state%trace%interaction_t, sf_int, sf_out_i)
	end do
	i_out = [(i, i = n_vir + 1, n_tot)]
	call state%expr%setup_subevt (state%trace%interaction_t, &
	i_beam, i_in, i_out, f_beam, f_in, f_out)
	state%has_expr = .true.
	end subroutine connected_state_setup_subevt

	@ %def connected_state_setup_subevt
	<<Parton states: connected state: TBP>>=
	procedure :: renew_flv_content_subevt => &
	connected_state_renew_flv_content_subevt
	<<Parton states: sub interfaces>>=
	module subroutine connected_state_renew_flv_content_subevt &
	(state, sf_chain, f_beam, f_in, f_out)
	class(connected_state_t), intent(inout), target :: state
	type(sf_chain_instance_t), intent(in), target :: sf_chain
	type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
	end subroutine connected_state_renew_flv_content_subevt
	<<Parton states: procedures>>=
	module subroutine connected_state_renew_flv_content_subevt &
	(state, sf_chain, f_beam, f_in, f_out)
	class(connected_state_t), intent(inout), target :: state
	type(sf_chain_instance_t), intent(in), target :: sf_chain
	type(flavor_t), dimension(:), intent(in) :: f_beam, f_in, f_out
	integer :: n_beam, n_in, n_out, n_vir, n_tot, i, j
	integer, dimension(:), allocatable :: i_beam, i_in, i_out
	integer :: sf_out_i
	type(interaction_t), pointer :: sf_int
	sf_int => sf_chain%get_out_int_ptr ()
	n_beam = size (f_beam)
	n_in = size (f_in)
	n_out = size (f_out)
	n_vir = state%trace%get_n_vir ()
	n_tot = state%trace%get_n_tot ()
	allocate (i_beam (n_beam), i_in (n_in), i_out (n_out))
	i_beam = [(i, i = 1, n_beam)]
	do j = 1, n_in
	sf_out_i = sf_chain%get_out_i (j)
	i_in(j) = interaction_find_link &
	(state%trace%interaction_t, sf_int, sf_out_i)
	end do
	i_out = [(i, i = n_vir + 1, n_tot)]
	call state%expr%renew_flv_content_subevt (state%trace%interaction_t, &
	i_beam, i_in, i_out, f_beam, f_in, f_out)
	state%has_expr = .true.
	end subroutine connected_state_renew_flv_content_subevt

	@ %def connected_state_setup_subevt
	@ Initialize the variable list specific for this state/term. We insert event
	variables ([[sqrts_hat]]) and link the process variable list. The variable
	list acquires pointers to subobjects of [[state]], which must therefore have a
	[[target]] attribute.
	<<Parton states: connected state: TBP>>=
	procedure :: setup_var_list => connected_state_setup_var_list
	<<Parton states: sub interfaces>>=
	module subroutine connected_state_setup_var_list &
	(state, process_var_list, beam_data)
	class(connected_state_t), intent(inout), target :: state
	type(var_list_t), intent(in), target :: process_var_list
	type(beam_data_t), intent(in) :: beam_data
	end subroutine connected_state_setup_var_list
	<<Parton states: procedures>>=
	module subroutine connected_state_setup_var_list &
	(state, process_var_list, beam_data)
	class(connected_state_t), intent(inout), target :: state
	type(var_list_t), intent(in), target :: process_var_list
	type(beam_data_t), intent(in) :: beam_data
	call state%expr%setup_vars (beam_data%get_sqrts ())
	call state%expr%link_var_list (process_var_list)
	end subroutine connected_state_setup_var_list

	@ %def connected_state_setup_var_list
	@ Allocate the cut expression etc.
	<<Parton states: connected state: TBP>>=
	procedure :: setup_cuts => connected_state_setup_cuts
	procedure :: setup_scale => connected_state_setup_scale
	procedure :: setup_fac_scale => connected_state_setup_fac_scale
	procedure :: setup_ren_scale => connected_state_setup_ren_scale
	procedure :: setup_weight => connected_state_setup_weight
	<<Parton states: sub interfaces>>=
	module subroutine connected_state_setup_cuts (state, ef_cuts)
	class(connected_state_t), intent(inout), target :: state
	class(expr_factory_t), intent(in) :: ef_cuts
	end subroutine connected_state_setup_cuts
	module subroutine connected_state_setup_scale (state, ef_scale)
	class(connected_state_t), intent(inout), target :: state
	class(expr_factory_t), intent(in) :: ef_scale
	end subroutine connected_state_setup_scale
	module subroutine connected_state_setup_fac_scale (state, ef_fac_scale)
	class(connected_state_t), intent(inout), target :: state
	class(expr_factory_t), intent(in) :: ef_fac_scale
	end subroutine connected_state_setup_fac_scale
	module subroutine connected_state_setup_ren_scale (state, ef_ren_scale)
	class(connected_state_t), intent(inout), target :: state
	class(expr_factory_t), intent(in) :: ef_ren_scale
	end subroutine connected_state_setup_ren_scale
	module subroutine connected_state_setup_weight (state, ef_weight)
	class(connected_state_t), intent(inout), target :: state
	class(expr_factory_t), intent(in) :: ef_weight
	end subroutine connected_state_setup_weight
	<<Parton states: procedures>>=
	module subroutine connected_state_setup_cuts (state, ef_cuts)
	class(connected_state_t), intent(inout), target :: state
	class(expr_factory_t), intent(in) :: ef_cuts
	call state%expr%setup_selection (ef_cuts)
	end subroutine connected_state_setup_cuts

	module subroutine connected_state_setup_scale (state, ef_scale)
	class(connected_state_t), intent(inout), target :: state
	class(expr_factory_t), intent(in) :: ef_scale
	call state%expr%setup_scale (ef_scale)
	end subroutine connected_state_setup_scale

	module subroutine connected_state_setup_fac_scale (state, ef_fac_scale)
	class(connected_state_t), intent(inout), target :: state
	class(expr_factory_t), intent(in) :: ef_fac_scale
	call state%expr%setup_fac_scale (ef_fac_scale)
	end subroutine connected_state_setup_fac_scale

	module subroutine connected_state_setup_ren_scale (state, ef_ren_scale)
	class(connected_state_t), intent(inout), target :: state
	class(expr_factory_t), intent(in) :: ef_ren_scale
	call state%expr%setup_ren_scale (ef_ren_scale)
	end subroutine connected_state_setup_ren_scale

	module subroutine connected_state_setup_weight (state, ef_weight)
	class(connected_state_t), intent(inout), target :: state
	class(expr_factory_t), intent(in) :: ef_weight
	call state%expr%setup_weight (ef_weight)
	end subroutine connected_state_setup_weight

	@ %def connected_state_setup_expressions
	@ Reset the expression object: invalidate the subevt.
	<<Parton states: connected state: TBP>>=
	procedure :: reset_expressions => connected_state_reset_expressions
	<<Parton states: sub interfaces>>=
	module subroutine connected_state_reset_expressions (state)
	class(connected_state_t), intent(inout) :: state
	end subroutine connected_state_reset_expressions
	<<Parton states: procedures>>=
	module subroutine connected_state_reset_expressions (state)
	class(connected_state_t), intent(inout) :: state
	if (state%has_expr) call state%expr%reset_contents ()
	end subroutine connected_state_reset_expressions

	@ %def connected_state_reset_expressions
	@
	\subsection{Evaluation}
	Transfer momenta to the trace evaluator and fill the [[subevt]] with
	this effective kinematics, if applicable.

	Note: we may want to apply a boost for the [[subevt]].
	<<Parton states: parton state: TBP>>=
	procedure :: receive_kinematics => parton_state_receive_kinematics
	<<Parton states: sub interfaces>>=
	module subroutine parton_state_receive_kinematics (state)
	class(parton_state_t), intent(inout), target :: state
	end subroutine parton_state_receive_kinematics
	<<Parton states: procedures>>=
	module subroutine parton_state_receive_kinematics (state)
	class(parton_state_t), intent(inout), target :: state
	if (state%has_trace) then
	call state%trace%receive_momenta ()
	select type (state)
	class is (connected_state_t)
	if (state%has_expr) then
	call state%expr%fill_subevt (state%trace%interaction_t)
	end if
	end select
	end if
	end subroutine parton_state_receive_kinematics

	@ %def parton_state_receive_kinematics
	@ Recover kinematics: We assume that the trace evaluator is filled
	with momenta. Send those momenta back to the sources, then fill the
	variables and subevent as above.

	The incoming momenta of the connected state are not connected to the
	isolated state but to the beam interaction. Therefore, the incoming
	momenta within the isolated state do not become defined, yet.
	Instead, we reconstruct the beam (and ISR) momentum configuration.
	<<Parton states: parton state: TBP>>=
	procedure :: send_kinematics => parton_state_send_kinematics
	<<Parton states: sub interfaces>>=
	module subroutine parton_state_send_kinematics (state)
	class(parton_state_t), intent(inout), target :: state
	end subroutine parton_state_send_kinematics
	<<Parton states: procedures>>=
	module subroutine parton_state_send_kinematics (state)
	class(parton_state_t), intent(inout), target :: state
	if (state%has_trace) then
	call state%trace%send_momenta ()
	select type (state)
	class is (connected_state_t)
	call state%expr%fill_subevt (state%trace%interaction_t)
	end select
	end if
	end subroutine parton_state_send_kinematics

	@ %def parton_state_send_kinematics
	@ Evaluate the expressions. The routine evaluates first the cut expression.
	If the event passes, it evaluates the other expressions. Where no expressions
	are defined, default values are inserted.
	<<Parton states: connected state: TBP>>=
	procedure :: evaluate_expressions => connected_state_evaluate_expressions
	<<Parton states: sub interfaces>>=
	module subroutine connected_state_evaluate_expressions (state, passed, &
	scale, fac_scale, ren_scale, weight, scale_forced, force_evaluation)
	class(connected_state_t), intent(inout) :: state
	logical, intent(out) :: passed
	real(default), intent(out) :: scale, weight
	real(default), intent(out), allocatable :: fac_scale, ren_scale
	real(default), intent(in), allocatable, optional :: scale_forced
	logical, intent(in), optional :: force_evaluation
	end subroutine connected_state_evaluate_expressions
	<<Parton states: procedures>>=
	module subroutine connected_state_evaluate_expressions (state, passed, &
	scale, fac_scale, ren_scale, weight, scale_forced, force_evaluation)
	class(connected_state_t), intent(inout) :: state
	logical, intent(out) :: passed
	real(default), intent(out) :: scale, weight
	real(default), intent(out), allocatable :: fac_scale, ren_scale
	real(default), intent(in), allocatable, optional :: scale_forced
	logical, intent(in), optional :: force_evaluation
	if (state%has_expr) then
	call state%expr%evaluate (passed, scale, fac_scale, ren_scale, weight, &
	scale_forced, force_evaluation)
	end if
	end subroutine connected_state_evaluate_expressions

	@ %def connected_state_evaluate_expressions
	@ Evaluate the structure-function chain, if it is allocated
	explicitly. The argument is the factorization scale.

	If the chain is merely a pointer, the chain should already be
	evaluated at this point.
	<<Parton states: isolated state: TBP>>=
	procedure :: evaluate_sf_chain => isolated_state_evaluate_sf_chain
	<<Parton states: sub interfaces>>=
	module subroutine isolated_state_evaluate_sf_chain (state, fac_scale)
	class(isolated_state_t), intent(inout) :: state
	real(default), intent(in) :: fac_scale
	end subroutine isolated_state_evaluate_sf_chain
	<<Parton states: procedures>>=
	module subroutine isolated_state_evaluate_sf_chain (state, fac_scale)
	class(isolated_state_t), intent(inout) :: state
	real(default), intent(in) :: fac_scale
	if (state%sf_chain_is_allocated) &
	call state%sf_chain_eff%evaluate (fac_scale)
	end subroutine isolated_state_evaluate_sf_chain

	@ %def isolated_state_evaluate_sf_chain
	@ Evaluate the trace.
	<<Parton states: parton state: TBP>>=
	procedure :: evaluate_trace => parton_state_evaluate_trace
	<<Parton states: sub interfaces>>=
	module subroutine parton_state_evaluate_trace (state)
	class(parton_state_t), intent(inout) :: state
	end subroutine parton_state_evaluate_trace
	<<Parton states: procedures>>=
	module subroutine parton_state_evaluate_trace (state)
	class(parton_state_t), intent(inout) :: state
	if (state%has_trace) call state%trace%evaluate ()
	end subroutine parton_state_evaluate_trace

	@ %def parton_state_evaluate_trace
	<<Parton states: parton state: TBP>>=
	procedure :: evaluate_matrix => parton_state_evaluate_matrix
	<<Parton states: sub interfaces>>=
	module subroutine parton_state_evaluate_matrix (state)
	class(parton_state_t), intent(inout) :: state
	end subroutine parton_state_evaluate_matrix
	<<Parton states: procedures>>=
	module subroutine parton_state_evaluate_matrix (state)
	class(parton_state_t), intent(inout) :: state
	if (state%has_matrix) call state%matrix%evaluate ()
	end subroutine parton_state_evaluate_matrix

	@ %def parton_state_evaluate_matrix
	@ Evaluate the extra evaluators that we need for physical events.
	<<Parton states: parton state: TBP>>=
	procedure :: evaluate_event_data => parton_state_evaluate_event_data
	<<Parton states: sub interfaces>>=
	module subroutine parton_state_evaluate_event_data (state, only_momenta)
	class(parton_state_t), intent(inout) :: state
	logical, intent(in), optional :: only_momenta
	end subroutine parton_state_evaluate_event_data
	<<Parton states: procedures>>=
	module subroutine parton_state_evaluate_event_data (state, only_momenta)
	class(parton_state_t), intent(inout) :: state
	logical, intent(in), optional :: only_momenta
	logical :: only_mom
	only_mom = .false.; if (present (only_momenta)) only_mom = only_momenta
	select type (state)
	type is (connected_state_t)
	if (state%has_flows_sf) then
	call state%flows_sf%receive_momenta ()
	if (.not. only_mom) call state%flows_sf%evaluate ()
	end if
	end select
	if (state%has_matrix) then
	call state%matrix%receive_momenta ()
	if (.not. only_mom) call state%matrix%evaluate ()
	end if
	if (state%has_flows) then
	call state%flows%receive_momenta ()
	if (.not. only_mom) call state%flows%evaluate ()
	end if
	end subroutine parton_state_evaluate_event_data

	@ %def parton_state_evaluate_event_data
	@ Normalize the helicity density matrix by its trace, i.e., factor out
	the trace and put it into an overall normalization factor. The trace
	and flow evaluators are unchanged.
	<<Parton states: parton state: TBP>>=
	procedure :: normalize_matrix_by_trace => &
	parton_state_normalize_matrix_by_trace
	<<Parton states: sub interfaces>>=
	module subroutine parton_state_normalize_matrix_by_trace (state)
	class(parton_state_t), intent(inout) :: state
	end subroutine parton_state_normalize_matrix_by_trace
	<<Parton states: procedures>>=
	module subroutine parton_state_normalize_matrix_by_trace (state)
	class(parton_state_t), intent(inout) :: state
	if (state%has_matrix) call state%matrix%normalize_by_trace ()
	end subroutine parton_state_normalize_matrix_by_trace

	@ %def parton_state_normalize_matrix_by_trace
	@
	\subsection{Accessing the state}
	Three functions return a pointer to the event-relevant interactions.
	<<Parton states: parton state: TBP>>=
	procedure :: get_trace_int_ptr => parton_state_get_trace_int_ptr
	procedure :: get_matrix_int_ptr => parton_state_get_matrix_int_ptr
	procedure :: get_flows_int_ptr => parton_state_get_flows_int_ptr
	<<Parton states: sub interfaces>>=
	module function parton_state_get_trace_int_ptr (state) result (ptr)
	class(parton_state_t), intent(in), target :: state
	type(interaction_t), pointer :: ptr
	end function parton_state_get_trace_int_ptr
	module function parton_state_get_matrix_int_ptr (state) result (ptr)
	class(parton_state_t), intent(in), target :: state
	type(interaction_t), pointer :: ptr
	end function parton_state_get_matrix_int_ptr
	module function parton_state_get_flows_int_ptr (state) result (ptr)
	class(parton_state_t), intent(in), target :: state
	type(interaction_t), pointer :: ptr
	end function parton_state_get_flows_int_ptr
	<<Parton states: procedures>>=
	module function parton_state_get_trace_int_ptr (state) result (ptr)
	class(parton_state_t), intent(in), target :: state
	type(interaction_t), pointer :: ptr
	if (state%has_trace) then
	ptr => state%trace%interaction_t
	else
	ptr => null ()
	end if
	end function parton_state_get_trace_int_ptr

	module function parton_state_get_matrix_int_ptr (state) result (ptr)
	class(parton_state_t), intent(in), target :: state
	type(interaction_t), pointer :: ptr
	if (state%has_matrix) then
	ptr => state%matrix%interaction_t
	else
	ptr => null ()
	end if
	end function parton_state_get_matrix_int_ptr

	module function parton_state_get_flows_int_ptr (state) result (ptr)
	class(parton_state_t), intent(in), target :: state
	type(interaction_t), pointer :: ptr
	if (state%has_flows) then
	ptr => state%flows%interaction_t
	else
	ptr => null ()
	end if
	end function parton_state_get_flows_int_ptr

	@ %def parton_state_get_trace_int_ptr
	@ %def parton_state_get_matrix_int_ptr
	@ %def parton_state_get_flows_int_ptr
	@ Return the indices of the beam particles and the outgoing particles within
	the trace (and thus, matrix and flows) evaluator, respectively.
	<<Parton states: connected state: TBP>>=
	procedure :: get_beam_index => connected_state_get_beam_index
	procedure :: get_in_index => connected_state_get_in_index
	<<Parton states: sub interfaces>>=
	module subroutine connected_state_get_beam_index (state, i_beam)
	class(connected_state_t), intent(in) :: state
	integer, dimension(:), intent(out) :: i_beam
	end subroutine connected_state_get_beam_index
	module subroutine connected_state_get_in_index (state, i_in)
	class(connected_state_t), intent(in) :: state
	integer, dimension(:), intent(out) :: i_in
	end subroutine connected_state_get_in_index
	<<Parton states: procedures>>=
	module subroutine connected_state_get_beam_index (state, i_beam)
	class(connected_state_t), intent(in) :: state
	integer, dimension(:), intent(out) :: i_beam
	call state%expr%get_beam_index (i_beam)
	end subroutine connected_state_get_beam_index

	module subroutine connected_state_get_in_index (state, i_in)
	class(connected_state_t), intent(in) :: state
	integer, dimension(:), intent(out) :: i_in
	call state%expr%get_in_index (i_in)
	end subroutine connected_state_get_in_index

	@ %def connected_state_get_beam_index
	@ %def connected_state_get_in_index
	@
	<<Parton states: public>>=
	public :: refill_evaluator
	<<Parton states: sub interfaces>>=
	module subroutine refill_evaluator (sqme, qn, flv_index, evaluator)
	complex(default), intent(in), dimension(:) :: sqme
	type(quantum_numbers_t), intent(in), dimension(:,:) :: qn
	integer, intent(in), dimension(:), optional :: flv_index
	type(evaluator_t), intent(inout) :: evaluator
	end subroutine refill_evaluator
	<<Parton states: procedures>>=
	module subroutine refill_evaluator (sqme, qn, flv_index, evaluator)
	complex(default), intent(in), dimension(:) :: sqme
	type(quantum_numbers_t), intent(in), dimension(:,:) :: qn
	integer, intent(in), dimension(:), optional :: flv_index
	type(evaluator_t), intent(inout) :: evaluator
	integer :: i, i_flv
	do i = 1, size (sqme)
	if (present (flv_index)) then
	i_flv = flv_index(i)
	else
	i_flv = i
	end if
	call evaluator%add_to_matrix_element (qn(:,i_flv), sqme(i), &
	match_only_flavor = .true.)
	end do
	end subroutine refill_evaluator

	@ %def refill_evaluator
	@ Return the number of outgoing (hard) particles for the state.
	<<Parton states: parton state: TBP>>=
	procedure :: get_n_out => parton_state_get_n_out
	<<Parton states: sub interfaces>>=
	module function parton_state_get_n_out (state) result (n)
	class(parton_state_t), intent(in), target :: state
	integer :: n
	end function parton_state_get_n_out
	<<Parton states: procedures>>=
	module function parton_state_get_n_out (state) result (n)
	class(parton_state_t), intent(in), target :: state
	integer :: n
	n = state%trace%get_n_out ()
	end function parton_state_get_n_out

	@ %def parton_state_get_n_out
	@
	\subsection{Unit tests}
	<<[[parton_states_ut.f90]]>>=
	<<File header>>

	module parton_states_ut
	use unit_tests
	use parton_states_uti

	<<Standard module head>>

	<<Parton states: public test>>

	contains

	<<Parton states: test driver>>

	end module parton_states_ut
	@ %def parton_states_ut
	<<[[parton_states_uti.f90]]>>=
	<<File header>>

	module parton_states_uti

	<<Use kinds>>
	<<Use strings>>
	use constants, only: zero
	use numeric_utils
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use sf_base, only: sf_chain_instance_t
	use state_matrices, only: state_matrix_t
	use prc_template_me, only: prc_template_me_t
	use interactions, only: interaction_t
	use models, only: model_t, create_test_model
	use parton_states

	<<Standard module head>>

	<<Parton states: test declarations>>

	contains

	<<Parton states: tests>>

	end module parton_states_uti
	@ %def parton_states_uti
	@
	<<Parton states: public test>>=
	public :: parton_states_test
	<<Parton states: test driver>>=
	subroutine parton_states_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Parton states: execute tests>>
	end subroutine parton_states_test

	@ %def parton_states_test
	@
	\subsubsection{Test a simple isolated state}
	<<Parton states: execute tests>>=
	call test (parton_states_1, "parton_states_1", &
	"Create a 2 -> 2 isolated state and compute trace", &
	u, results)
	<<Parton states: test declarations>>=
	public :: parton_states_1
	<<Parton states: tests>>=
	subroutine parton_states_1 (u)
	integer, intent(in) :: u
	type(state_matrix_t), allocatable :: state
	type(flavor_t), dimension(2) :: flv_in
	type(flavor_t), dimension(2) :: flv_out1, flv_out2
	type(flavor_t), dimension(4) :: flv_tot
	type(helicity_t), dimension(4) :: hel
	type(color_t), dimension(4) :: col
	integer :: h1, h2, h3, h4
	integer :: f
	integer :: i
	type(quantum_numbers_t), dimension(4) :: qn
	type(prc_template_me_t) :: core
	type(sf_chain_instance_t), target :: sf_chain
	type(interaction_t), target :: int
	type(isolated_state_t) :: isolated_state
	integer :: n_states = 0
	integer, dimension(:), allocatable :: col_flow_index
	type(quantum_numbers_mask_t), dimension(2) :: qn_mask
	integer, dimension(8) :: i_allowed_states
	complex(default), dimension(8) :: me
	complex(default) :: me_check_tot, me_check_1, me_check_2, me2
	logical :: tmp1, tmp2
	type(model_t), pointer :: test_model => null ()

	write (u, "(A)") "* Test output: parton_states_1"
	write (u, "(A)") "* Purpose: Test the standard parton states"
	write (u, "(A)")

	call flv_in%init ([11, -11])
	call flv_out1%init ([1, -1])
	call flv_out2%init ([2, -2])

	write (u, "(A)") "* Using incoming flavors: "
	call flavor_write_array (flv_in, u)
	write (u, "(A)") "* Two outgoing flavor structures: "
	call flavor_write_array (flv_out1, u)
	call flavor_write_array (flv_out2, u)


	write (u, "(A)") "* Initialize state matrix"
	allocate (state)
	call state%init ()

	write (u, "(A)") "* Fill state matrix"
	call col(3)%init ([1])
	call col(4)%init ([-1])
	do f = 1, 2
	do h1 = -1, 1, 2
	do h2 = -1, 1, 2
	do h3 = -1, 1, 2
	do h4 = -1, 1, 2
	n_states = n_states + 1
	call hel%init ([h1, h2, h3, h4], [h1, h2, h3, h4])
	if (f == 1) then
	flv_tot = [flv_in, flv_out1]
	else
	flv_tot = [flv_in, flv_out2]
	end if
	call qn%init (flv_tot, col, hel)
	call state%add_state (qn)
	end do
	end do
	end do
	end do
	end do

	!!! Two flavors, one color flow, 2 x 2 x 2 x 2 helicity configurations
	!!! -> 32 states.
	write (u, "(A)")
	write (u, "(A,I2)") "* Generated number of states: ", n_states

	call state%freeze ()

	!!! Indices of the helicity configurations which are non-zero
	i_allowed_states = [6, 7, 10, 11, 22, 23, 26, 27]
	me = [cmplx (-1.89448E-5_default, 9.94456E-7_default, default), &
	cmplx (-8.37887E-2_default, 4.30842E-3_default, default), &
	cmplx (-1.99997E-1_default, -1.01985E-2_default, default), &
	cmplx ( 1.79717E-5_default, 9.27038E-7_default, default), &
	cmplx (-1.74859E-5_default, 8.78819E-7_default, default), &
	cmplx ( 1.67577E-1_default, -8.61683E-3_default, default), &
	cmplx ( 2.41331E-1_default, 1.23306E-2_default, default), &
	cmplx (-3.59435E-5_default, -1.85407E-6_default, default)]
	me_check_tot = cmplx (zero, zero, default)
	me_check_1 = cmplx (zero, zero, default)
	me_check_2 = cmplx (zero, zero, default)
	do i = 1, 8
	me2 = me(i) * conjg (me(i))
	me_check_tot = me_check_tot + me2
	if (i < 5) then
	me_check_1 = me_check_1 + me2
	else
	me_check_2 = me_check_2 + me2
	end if
	call state%set_matrix_element (i_allowed_states(i), me(i))
	end do

	!!! Do not forget the color factor
	me_check_tot = 3._default * me_check_tot
	me_check_1 = 3._default * me_check_1
	me_check_2 = 3._default * me_check_2
	write (u, "(A)")

	write (u, "(A)") "* Setup interaction"
	call int%basic_init (2, 0, 2, set_relations = .true.)
	call int%set_state_matrix (state)

	core%data%n_in = 2; core%data%n_out = 2
	core%data%n_flv = 2
	allocate (core%data%flv_state (4, 2))
	core%data%flv_state (1, :) = [11, 11]
	core%data%flv_state (2, :) = [-11, -11]
	core%data%flv_state (3, :) = [1, 2]
	core%data%flv_state (4, :) = [-1, -2]
	core%use_color_factors = .false.
	core%nc = 3

	write (u, "(A)") "* Init isolated state"
	call isolated_state%init (sf_chain, int)
	!!! There is only one color flow.
	allocate (col_flow_index (n_states)); col_flow_index = 1
	call qn_mask%init (.false., .false., .true., mask_cg = .false.)
	write (u, "(A)") "* Give a trace to the isolated state"
	call isolated_state%setup_square_trace (core, qn_mask, col_flow_index, .false.)
	call isolated_state%evaluate_trace ()
	write (u, "(A)")
	write (u, "(A)", advance = "no") "* Squared matrix element correct: "
	write (u, "(L1)") nearly_equal (me_check_tot, &
	isolated_state%trace%get_matrix_element (1), rel_smallness = 0.00001_default)


	write (u, "(A)") "* Give a matrix to the isolated state"
	call create_test_model (var_str ("SM"), test_model)
	call isolated_state%setup_square_matrix (core, test_model, qn_mask, col_flow_index)
	call isolated_state%evaluate_matrix ()

	write (u, "(A)") "* Sub-matrixelements correct: "
	tmp1 = nearly_equal (me_check_1, &
	isolated_state%matrix%get_matrix_element (1), rel_smallness = 0.00001_default)
	tmp2 = nearly_equal (me_check_2, &
	isolated_state%matrix%get_matrix_element (2), rel_smallness = 0.00001_default)
	write (u, "(A,L1,A,L1)") "* 1: ", tmp1, ", 2: ", tmp2

	write (u, "(A)") "* Test output end: parton_states_1"
	end subroutine parton_states_1

	@ %def parton_states_1
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process component management}
	This module contains tools for managing and combining process
	components and matrix-element code and values, acting at a level below
	the actual process definition.

	\subsection{Abstract base type}
	The types introduced here are abstract base types.
	<<[[pcm_base.f90]]>>=
	<<File header>>

	module pcm_base

	<<Use kinds>>
	<<Use strings>>
	use os_interface, only: os_data_t

	use process_libraries, only: process_library_t

	use prc_core_def
	use prc_core

	use variables, only: var_list_t
	use mappings, only: mapping_defaults_t
	use phs_base, only: phs_config_t
	use phs_forests, only: phs_parameters_t
	use mci_base, only: mci_t
	use model_data, only: model_data_t
	use models, only: model_t

	use blha_config, only: blha_master_t
	use blha_olp_interfaces, only: blha_template_t
	use process_config
	use process_mci, only: process_mci_entry_t

	<<Standard module head>>

	<<PCM base: public>>

	<<PCM base: parameters>>

	<<PCM base: types>>

	<<PCM base: interfaces>>

	interface
	<<PCM base: sub interfaces>>
	end interface

	end module pcm_base
	@ %def pcm_base
	@
	<<[[pcm_base_sub.f90]]>>=
	<<File header>>

	submodule (pcm_base) pcm_base_s

	use io_units
	use diagnostics
	use format_utils, only: write_integer_array
	use format_utils, only: write_separator
	use physics_defs, only: BORN, NLO_REAL
	!!! Intel oneAPI 2022/23 regression workaround
	use process_libraries, only: process_library_t
	use variables, only: var_list_t

	implicit none

	contains

	<<PCM base: procedures>>

	end submodule pcm_base_s

	@ %def pcm_base_s
	@
	\subsection{Core management}
	This object holds information about the cores used by the components
	and allocates the corresponding manager instance.

	[[i_component]] is the index of the process component which this core belongs
	to. The pointer to the core definition is a convenient help in configuring
	the core itself.

	We allow for a [[blha_config]] configuration object that covers BLHA cores.
	The BLHA standard is suitable generic to warrant support outside of specific
	type extension (i.e., applies to LO and NLO if requested). The BLHA
	configuration is allocated only if the core requires it.
	<<PCM base: public>>=
	public :: core_entry_t
	<<PCM base: types>>=
	type :: core_entry_t
	integer :: i_component = 0
	logical :: active = .false.
	class(prc_core_def_t), pointer :: core_def => null ()
	type(blha_template_t), allocatable :: blha_config
	class(prc_core_t), allocatable :: core
	contains
	<<PCM base: core entry: TBP>>
	end type core_entry_t

	@ %def core_entry_t
	@
	<<PCM base: core entry: TBP>>=
	procedure :: get_core_ptr => core_entry_get_core_ptr
	<<PCM base: sub interfaces>>=
	module function core_entry_get_core_ptr (core_entry) result (core)
	class(core_entry_t), intent(in), target :: core_entry
	class(prc_core_t), pointer :: core
	end function core_entry_get_core_ptr
	<<PCM base: procedures>>=
	module function core_entry_get_core_ptr (core_entry) result (core)
	class(core_entry_t), intent(in), target :: core_entry
	class(prc_core_t), pointer :: core
	if (allocated (core_entry%core)) then
	core => core_entry%core
	else
	core => null ()
	end if
	end function core_entry_get_core_ptr

	@ %def core_entry_get_core_ptr
	@ Configure the core object after allocation with correct type. The
	[[core_def]] object pointer and the index [[i_component]] of the associated
	process component are already there.
	<<PCM base: core entry: TBP>>=
	procedure :: configure => core_entry_configure
	<<PCM base: sub interfaces>>=
	module subroutine core_entry_configure (core_entry, lib, id)
	class(core_entry_t), intent(inout) :: core_entry
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	end subroutine core_entry_configure
	<<PCM base: procedures>>=
	module subroutine core_entry_configure (core_entry, lib, id)
	class(core_entry_t), intent(inout) :: core_entry
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	call core_entry%core%init &
	(core_entry%core_def, lib, id, core_entry%i_component)
	end subroutine core_entry_configure

	@ %def core_entry_configure
	@
	\subsection{Process component manager}
	The process-component manager [[pcm]] is the master component of the
	[[process_t]] object. It serves two purposes:
	\begin{enumerate}
	\item
	It holds configuration data which allow us to centrally manage the
	components, terms, etc.\ of the process object.
	\item
	It implements the methods that realize the algorithm for constructing
	the process object and computing an integral. This algorithm makes
	use of the data stored within [[pcm]].
	\end{enumerate}
	To this end, the object is abstract and polymorphic. The two
	extensions that we support, implement (a) default tree-level
	calculation, optionally including a sum over sub-processes with
	different particle content, or (b) the FKS-NLO subtraction algorithm for
	QCD-corrected processes. In both cases, the type extensions may hold
	suitable further data.

	Data included in the base type:

	The number of components determines the [[component_selected]] array.

	[[i_phs_config]] is a lookup table that holds the PHS configuration index
	for a given component index.

	[[i_core]] is a lookup table that holds the core-entry index for a
	given component index.

	[[i_mci]] is a lookup table that holds the integrator (MCI) index for
	a given component index.
	<<PCM base: public>>=
	public :: pcm_t
	<<PCM base: types>>=
	type, abstract :: pcm_t
	logical :: initialized = .false.
	logical :: has_pdfs = .false.
	integer :: n_components = 0
	integer :: n_cores = 0
	integer :: n_mci = 0
	logical, dimension(:), allocatable :: component_selected
	logical, dimension(:), allocatable :: component_active
	integer, dimension(:), allocatable :: i_phs_config
	integer, dimension(:), allocatable :: i_core
	integer, dimension(:), allocatable :: i_mci
	type(blha_template_t) :: blha_defaults
	logical :: uses_blha = .false.
	type(os_data_t) :: os_data
	contains
	<<PCM base: pcm: TBP>>
	end type pcm_t

	@ %def pcm_t
	@ The factory method. We use the [[inout]] intent, so calling this
	again is an error.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_allocate_workspace), deferred :: allocate_workspace
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_allocate_workspace (pcm, work)
	import
	class(pcm_t), intent(in) :: pcm
	class(pcm_workspace_t), intent(inout), allocatable :: work
	end subroutine pcm_allocate_workspace
	end interface

	@ %def pcm_allocate_workspace
	@
	<<PCM base: pcm: TBP>>=
	procedure(pcm_is_nlo), deferred :: is_nlo
	<<PCM base: interfaces>>=
	abstract interface
	function pcm_is_nlo (pcm) result (is_nlo)
	import
	logical :: is_nlo
	class(pcm_t), intent(in) :: pcm
	end function pcm_is_nlo
	end interface

	@ %def pcm_is_nlo
	@
	<<PCM base: pcm: TBP>>=
	procedure(pcm_final), deferred :: final
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_final (pcm)
	import
	class(pcm_t), intent(inout) :: pcm
	end subroutine pcm_final
	end interface

	@ %def pcm_final
	@
	\subsection{Initialization methods}
	The PCM has the duty to coordinate and configure the process-object
	components.

	Initialize the PCM configuration itself, using environment data.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_init), deferred :: init
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_init (pcm, env, meta)
	import
	class(pcm_t), intent(out) :: pcm
	type(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	end subroutine pcm_init
	end interface

	@ %def pcm_init
	@
	Initialize the BLHA configuration block, the component-independent default
	settings. This is to be called by [[pcm_init]]. We use the provided variable
	list.

	This block is filled regardless of whether BLHA is actually used, because why
	not? We use a default value for the scheme (not set in unit tests).
	<<PCM base: pcm: TBP>>=
	procedure :: set_blha_defaults => pcm_set_blha_defaults
	<<PCM base: sub interfaces>>=
	module subroutine pcm_set_blha_defaults (pcm, polarized_beams, var_list)
	class(pcm_t), intent(inout) :: pcm
	type(var_list_t), intent(in) :: var_list
	logical, intent(in) :: polarized_beams
	end subroutine pcm_set_blha_defaults
	<<PCM base: procedures>>=
	module subroutine pcm_set_blha_defaults (pcm, polarized_beams, var_list)
	class(pcm_t), intent(inout) :: pcm
	type(var_list_t), intent(in) :: var_list
	logical, intent(in) :: polarized_beams
	logical :: muon_yukawa_off
	real(default) :: top_yukawa
	type(string_t) :: ew_scheme
	muon_yukawa_off = &
	var_list%get_lval (var_str ("?openloops_switch_off_muon_yukawa"))
	top_yukawa = &
	var_list%get_rval (var_str ("blha_top_yukawa"))
	ew_scheme = &
	var_list%get_sval (var_str ("$blha_ew_scheme"))
	if (ew_scheme == "") ew_scheme = "Gmu"
	call pcm%blha_defaults%init &
	(polarized_beams, muon_yukawa_off, top_yukawa, ew_scheme)
	end subroutine pcm_set_blha_defaults

	@ %def pcm_set_blha_defaults
	@ Read the method settings from the variable list and store them in the BLHA
	master. The details depend on the [[pcm]] concrete type.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_set_blha_methods), deferred :: set_blha_methods
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_set_blha_methods (pcm, blha_master, var_list)
	import
	class(pcm_t), intent(inout) :: pcm
	type(blha_master_t), intent(inout) :: blha_master
	type(var_list_t), intent(in) :: var_list
	end subroutine pcm_set_blha_methods
	end interface

	@ %def pcm_set_blha_methods
	@ Produce the LO and NLO flavor-state tables (as far as available), as
	appropriate for BLHA configuration. We may inspect either the PCM itself or
	the array of process cores.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_get_blha_flv_states), deferred :: get_blha_flv_states
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_get_blha_flv_states (pcm, core_entry, flv_born, flv_real)
	import
	class(pcm_t), intent(in) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	integer, dimension(:,:), allocatable, intent(out) :: flv_born
	integer, dimension(:,:), allocatable, intent(out) :: flv_real
	end subroutine pcm_get_blha_flv_states
	end interface

	@ %def pcm_get_blha_flv_states
	@
	Allocate the right number of process components. The number is also stored in
	the process meta. Initially, all components are active but none are
	selected.
	<<PCM base: pcm: TBP>>=
	procedure :: allocate_components => pcm_allocate_components
	<<PCM base: sub interfaces>>=
	module subroutine pcm_allocate_components (pcm, comp, meta)
	class(pcm_t), intent(inout) :: pcm
	type(process_component_t), dimension(:), allocatable, intent(out) :: comp
	type(process_metadata_t), intent(in) :: meta
	end subroutine pcm_allocate_components
	<<PCM base: procedures>>=
	module subroutine pcm_allocate_components (pcm, comp, meta)
	class(pcm_t), intent(inout) :: pcm
	type(process_component_t), dimension(:), allocatable, intent(out) :: comp
	type(process_metadata_t), intent(in) :: meta
	pcm%n_components = meta%n_components
	allocate (comp (pcm%n_components))
	allocate (pcm%component_selected (pcm%n_components), source = .false.)
	allocate (pcm%component_active (pcm%n_components), source = .true.)
	end subroutine pcm_allocate_components

	@ %def pcm_allocate_components
	@ Each process component belongs to a category/type, which we identify by a
	universal integer constant. The categories can be taken from the process
	definition. For easy lookup, we store the categories in an array.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_categorize_components), deferred :: categorize_components
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_categorize_components (pcm, config)
	import
	class(pcm_t), intent(inout) :: pcm
	type(process_config_data_t), intent(in) :: config
	end subroutine pcm_categorize_components
	end interface

	@ %def pcm_categorize_components
	@
	Allocate the right number and type(s) of process-core
	objects, i.e., the interface object between the process and matrix-element
	code.

	Within the [[pcm]] block, also associate cores with components and store
	relevant configuration data, including the [[i_core]] lookup table.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_allocate_cores), deferred :: allocate_cores
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_allocate_cores (pcm, config, core_entry)
	import
	class(pcm_t), intent(inout) :: pcm
	type(process_config_data_t), intent(in) :: config
	type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
	end subroutine pcm_allocate_cores
	end interface

	@ %def pcm_allocate_cores
	@ Generate and interface external code for a single core, if this is
	required.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_prepare_any_external_code), deferred :: &
	prepare_any_external_code
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_prepare_any_external_code &
	(pcm, core_entry, i_core, libname, model, var_list)
	import
	class(pcm_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	integer, intent(in) :: i_core
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	type(var_list_t), intent(in) :: var_list
	end subroutine pcm_prepare_any_external_code
	end interface

	@ %def pcm_prepare_any_external_code
	@ Prepare the BLHA configuration for a core object that requires it. This
	does not affect the core object, which may not yet be allocated.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_setup_blha), deferred :: setup_blha
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_setup_blha (pcm, core_entry)
	import
	class(pcm_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	end subroutine pcm_setup_blha
	end interface

	@ %def pcm_setup_blha
	@ Configure the BLHA interface for a core object that requires it. This is
	separate from the previous method, assuming that the [[pcm]] has to allocate
	the actual cores and acquire some data in-between.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_prepare_blha_core), deferred :: prepare_blha_core
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_prepare_blha_core (pcm, core_entry, model)
	import
	class(pcm_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	class(model_data_t), intent(in), target :: model
	end subroutine pcm_prepare_blha_core
	end interface

	@ %def pcm_prepare_blha_core
	@ Allocate and configure the MCI (multi-channel integrator) records and their
	relation to process components, appropriate for the algorithm implemented by
	[[pcm]].

	Create a [[mci_t]] template: the procedure [[dispatch_mci]] is called as a
	factory method for allocating the [[mci_t]] object with a specific concrete
	type. The call may depend on the concrete [[pcm]] type.
	<<PCM base: public>>=
	public :: dispatch_mci_proc
	<<PCM base: interfaces>>=
	abstract interface
	subroutine dispatch_mci_proc (mci, var_list, process_id, is_nlo)
	import
	class(mci_t), allocatable, intent(out) :: mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	logical, intent(in), optional :: is_nlo
	end subroutine dispatch_mci_proc
	end interface

	@ %def dispatch_mci_proc
	<<PCM base: pcm: TBP>>=
	procedure(pcm_setup_mci), deferred :: setup_mci
	procedure(pcm_call_dispatch_mci), deferred :: call_dispatch_mci
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_setup_mci (pcm, mci_entry)
	import
	class(pcm_t), intent(inout) :: pcm
	type(process_mci_entry_t), &
	dimension(:), allocatable, intent(out) :: mci_entry
	end subroutine pcm_setup_mci
	end interface

	abstract interface
	subroutine pcm_call_dispatch_mci (pcm, &
	dispatch_mci, var_list, process_id, mci_template)
	import
	class(pcm_t), intent(inout) :: pcm
	procedure(dispatch_mci_proc) :: dispatch_mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	class(mci_t), intent(out), allocatable :: mci_template
	end subroutine pcm_call_dispatch_mci
	end interface

	@ %def pcm_setup_mci
	@ %def pcm_call_dispatch_mci
	@ Proceed with PCM configuration based on the core and component
	configuration data. Base version is empty.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_complete_setup), deferred :: complete_setup
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_complete_setup (pcm, core_entry, component, model)
	import
	class(pcm_t), intent(inout) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	type(process_component_t), dimension(:), intent(inout) :: component
	type(model_t), intent(in), target :: model
	end subroutine pcm_complete_setup
	end interface

	@ %def pcm_complete_setup
	@
	\subsubsection{Retrieve information}
	Return the core index that belongs to a particular component.
	<<PCM base: pcm: TBP>>=
	procedure :: get_i_core => pcm_get_i_core
	<<PCM base: sub interfaces>>=
	module function pcm_get_i_core (pcm, i_component) result (i_core)
	class(pcm_t), intent(in) :: pcm
	integer, intent(in) :: i_component
	integer :: i_core
	end function pcm_get_i_core
	<<PCM base: procedures>>=
	module function pcm_get_i_core (pcm, i_component) result (i_core)
	class(pcm_t), intent(in) :: pcm
	integer, intent(in) :: i_component
	integer :: i_core
	if (allocated (pcm%i_core)) then
	i_core = pcm%i_core(i_component)
	else
	i_core = 0
	end if
	end function pcm_get_i_core

	@ %def pcm_get_i_core
	@
	\subsubsection{Phase-space configuration}
	Allocate and initialize the right number and type(s) of phase-space
	configuration entries. The [[i_phs_config]] lookup table must be set
	accordingly.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_init_phs_config), deferred :: init_phs_config
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_init_phs_config &
	(pcm, phs_entry, meta, env, phs_par, mapping_defs)
	import
	class(pcm_t), intent(inout) :: pcm
	type(process_phs_config_t), &
	dimension(:), allocatable, intent(out) :: phs_entry
	type(process_metadata_t), intent(in) :: meta
	type(process_environment_t), intent(in) :: env
	type(mapping_defaults_t), intent(in) :: mapping_defs
	type(phs_parameters_t), intent(in) :: phs_par
	end subroutine pcm_init_phs_config
	end interface

	@ %def pcm_init_phs_config
	@
	Initialize a single component. We require all process-configuration blocks,
	and specific templates for the phase-space and integrator configuration.

	We also provide the current component index [[i]] and the [[active]] flag.
	<<PCM base: pcm: TBP>>=
	procedure(pcm_init_component), deferred :: init_component
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_init_component &
	(pcm, component, i, active, phs_config, env, meta, config)
	import
	class(pcm_t), intent(in) :: pcm
	type(process_component_t), intent(out) :: component
	integer, intent(in) :: i
	logical, intent(in) :: active
	class(phs_config_t), allocatable, intent(in) :: phs_config
	type(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	type(process_config_data_t), intent(in) :: config
	end subroutine pcm_init_component
	end interface

	@ %def pcm_init_component
	@
	Record components in the process [[meta]] data if they have turned
	out to be inactive.
	<<PCM base: pcm: TBP>>=
	procedure :: record_inactive_components => pcm_record_inactive_components
	<<PCM base: sub interfaces>>=
	module subroutine pcm_record_inactive_components (pcm, component, meta)
	class(pcm_t), intent(inout) :: pcm
	type(process_component_t), dimension(:), intent(in) :: component
	type(process_metadata_t), intent(inout) :: meta
	end subroutine pcm_record_inactive_components
	<<PCM base: procedures>>=
	module subroutine pcm_record_inactive_components (pcm, component, meta)
	class(pcm_t), intent(inout) :: pcm
	type(process_component_t), dimension(:), intent(in) :: component
	type(process_metadata_t), intent(inout) :: meta
	integer :: i
	pcm%component_active = component%active
	do i = 1, pcm%n_components
	if (.not. component(i)%active) call meta%deactivate_component (i)
	end do
	end subroutine pcm_record_inactive_components

	@ %def pcm_record_inactive_components
	@
	\subsection{Manager workspace}
	This object deals with the actual (squared) matrix element values. It
	holds any central data that are generated and/or used when calculating
	a particular phase-space point.

	Since phase-space points are associated with an integrator, we expect the
	instances of this type to correspond to MCI instances.
	<<PCM base: public>>=
	public :: pcm_workspace_t
	<<PCM base: types>>=
	type, abstract :: pcm_workspace_t
	! class(pcm_t), pointer :: config => null ()
	logical :: bad_point = .false.
	contains
	<<PCM base: pcm instance: TBP>>
	end type pcm_workspace_t

	@ %def pcm_workspace_t
	@
	<<PCM base: pcm instance: TBP>>=
	procedure(pcm_work_final), deferred :: final
	<<PCM base: interfaces>>=
	abstract interface
	subroutine pcm_work_final (pcm_work)
	import
	class(pcm_workspace_t), intent(inout) :: pcm_work
	end subroutine pcm_work_final
	end interface

	@ %def pcm_work_final
	@
	<<PCM base: pcm instance: TBP>>=
	procedure(pcm_work_is_nlo), deferred :: is_nlo
	<<PCM base: interfaces>>=
	abstract interface
	function pcm_work_is_nlo (pcm_work) result (is_nlo)
	import
	logical :: is_nlo
	class(pcm_workspace_t), intent(inout) :: pcm_work
	end function pcm_work_is_nlo
	end interface

	@ %def pcm_work_is_nlo
	@
	<<XXX PCM base: pcm instance: TBP>>=
	procedure :: link_config => pcm_work_link_config
	<<XXX PCM base: procedures>>=
	subroutine pcm_work_link_config (pcm_work, config)
	class(pcm_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in), target :: config
	pcm_work%config => config
	end subroutine pcm_work_link_config

	@ %def pcm_work_link_config
	@
	<<PCM base: pcm instance: TBP>>=
	procedure :: is_valid => pcm_work_is_valid
	<<PCM base: sub interfaces>>=
	module function pcm_work_is_valid (pcm_work) result (valid)
	logical :: valid
	class(pcm_workspace_t), intent(in) :: pcm_work
	end function pcm_work_is_valid
	<<PCM base: procedures>>=
	module function pcm_work_is_valid (pcm_work) result (valid)
	logical :: valid
	class(pcm_workspace_t), intent(in) :: pcm_work
	valid = .not. pcm_work%bad_point
	end function pcm_work_is_valid

	@ %def pcm_work_is_valid
	@
	<<PCM base: pcm instance: TBP>>=
	procedure :: set_bad_point => pcm_work_set_bad_point
	<<PCM base: sub interfaces>>=
	pure module subroutine pcm_work_set_bad_point (pcm_work, bad_point)
	class(pcm_workspace_t), intent(inout) :: pcm_work
	logical, intent(in) :: bad_point
	end subroutine pcm_work_set_bad_point
	<<PCM base: procedures>>=
	pure module subroutine pcm_work_set_bad_point (pcm_work, bad_point)
	class(pcm_workspace_t), intent(inout) :: pcm_work
	logical, intent(in) :: bad_point
	pcm_work%bad_point = pcm_work%bad_point .or. bad_point
	end subroutine pcm_work_set_bad_point

	@ %def pcm_work_set_bad_point
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{The process object}
	<<[[process.f90]]>>=
	<<File header>>

	module process

	<<Use kinds>>
	<<Use strings>>
	<<Use debug>>
	use diagnostics
	use lorentz
	use rng_base
	use dispatch_rng, only: dispatch_rng_factory
	use dispatch_rng, only: update_rng_seed_in_var_list
	use os_interface
	use sm_qcd
	use mci_base
	use flavors
	use model_data
	use models
	use process_libraries
	use process_constants
	use variables
	use beam_structures
	use beams
	use pdg_arrays
	use expr_base
	use sf_base
	use sf_mappings
	use resonances, only: resonance_history_t, resonance_history_set_t

	use prc_test_core, only: test_t
	use prc_core_def, only: prc_core_def_t
	use prc_core, only: prc_core_t, helicity_selection_t
	use phs_base

	use parton_states, only: connected_state_t
	use pcm_base
	use pcm
	use process_counter
	use process_config
	use process_mci

	<<Standard module head>>

	<<Process: public>>

	<<Process: types>>

	<<Process: interfaces>>

	interface
	<<Process: sub interfaces>>
	end interface

	contains

	<<Process: main procedures>>

	end module process
	@ %def process
	@
	<<[[process_sub.f90]]>>=
	<<File header>>

	submodule (process) process_s

	use io_units
	use format_utils, only: write_separator
	use constants
	use numeric_utils
	use cputime
	use md5
	use integration_results
	use physics_defs
	use interactions
	use particles
	use dispatch_phase_space, only: dispatch_phs
	use prc_external, only: prc_external_t
	use prc_recola, only: prc_recola_t
	use blha_olp_interfaces, only: prc_blha_t, blha_template_t
	use prc_threshold, only: prc_threshold_t
	use phs_fks, only: phs_fks_config_t
	use mappings, only: mapping_defaults_t
	use phs_forests, only: phs_parameters_t
	use phs_wood, only: phs_wood_config_t
	use blha_config, only: blha_master_t
	!!! Intel oneAPI 2022/23 regression workaround
	use prc_core, only: prc_core_t

	implicit none

	contains

	<<Process: procedures>>

	end submodule process_s

	@ %def process_s
	@
	\subsection{Process status}
	Store counter and status information in a process object.
	<<Process: types>>=
	type :: process_status_t
	private
	end type process_status_t

	@ %def process_status_t
	@
	\subsection{Process status}
	Store integration results in a process object.
	<<Process: types>>=
	type :: process_results_t
	private
	end type process_results_t

	@ %def process_results_t
	@
	\subsection{The process type}
	NOTE: The description below represents the intended structure after
	refactoring and disentangling the FKS-NLO vs. LO algorithm dependencies.

	A [[process]] object is the internal representation of integration-run
	methods and data, as they are controlled by the user via a Sindarin
	script. The process object provides access to matrix elements (the
	actual ``process'' definitions that the user has provided before), it
	defines the separation into individually integrable components, and it
	manages phase-space construction, the actual integration over phase
	space, and the accumulation of results.

	As a workspace for individual sampling calls, we introduce an
	associated [[process_instance]] object type elsewhere. The
	[[process]] object contains data that either define the configuration
	or accumulate results from a complete integration pass.

	After successful phase-space integration, subsequent event generation
	is not actually represented by the [[process]] object. However, any
	event generation refers to an existing [[process]] object which
	represents a specific integration pass, and it uses a fresh
	[[process_instance]] workspace for calculations.

	The process object consists of several subobjects with their specific
	purposes. The corresponding types are defined below. (Technically,
	the subobject type definitions have to come before the process type
	definition, but with NOWEB magic we reverse this order here.)

	The [[meta]] object describes the process globally. All
	contents become fixed when the object is initialized. Similarly, the
	[[env]] component captures the (Sindarin) environment at the point
	where the process object is initialized.

	The [[config]] object holds physical and technical configuration data
	that are collected and derived from the environment during process
	initialization, and which are common to all process components.

	The [[pcm]] object (process-component manager) is polymorphic. This
	is an object which holds data which represent the process-object
	structure and breakdown, and it contains the methods that implement
	the algorithm of managing this structure, accumulating partial
	results, and finally collecting the pieces. Depending on the generic
	process type, the contents of [[pcm]] do vary. In particular, there
	is some base-type data content and a simple (default) extension which
	is designed for traditional \oMega\ matrix elements and tree-level
	integration, possibly with several sub-processes to sum over. The
	second extension is designed for the FKS phase-space and subtraction
	algorithm for NLO QCD, which interfaces external one-loop providers.

	The [[component]] subobjects are, first of all, interfaces to the
	original process-component definitions that have been provided by the
	user, which the program has already taken to produce matrix-element
	code and interfaces. The management of those components is deferred
	by [[pcm]], which contains the information that defines the role of
	each component. In particular, in the default (LO) version, process
	components correspond to distinct particle combinations which have
	been included in the original process definition. In the FKS-NLO
	version, the breakdown of a NLO process into Born, real, virtual,
	etc.\ components determines the setup.

	The [[phs_config]] subobjects hold data that allow and implement the
	construction of phase-space configurations. The type
	[[process_phs_config_t]] is a wrapper type around the concrete
	polymorphic [[phs_config_t]] object type, which manages phase-space
	construction, including some bookkeeping required for setting up
	multi-channel integration. In the LO case, we expect a separate entry
	for each independent sub-process. For the FKS-NLO algorithm, we
	expect several entries: a default-type entry which implements the
	underlying Born phase space, and additional entries which enable
	the construction of various real-radiation and subtraction kinematics
	configurations.

	A [[core_entry]] is the interface to existing matrix-element and
	interaction code. Depending on the process and its components, there
	may be various distinct matrix elements to compute.

	The [[mci_entry]] objects configure distinct MC input parameter sets
	and their associated (multi-channel) integrators.

	The [[rng_factory]] object is a single objects which constructs
	individual random-number generators for various tasks, in a uniform
	and well-defined way.

	The [[beam_config]] object describes the incoming particles, either the
	decay mother or the scattering beams. It also contains the spectrum-
	and structure-function setup, which has to interact with the
	phase-space and integrator facilities.

	The [[term]] subobjects break down the process in its smallest parts
	which appear in the calculation. For LO processes, the correspondence
	between terms and components is one-to-one. The FKS-NLO algorithm
	requires not just separation of Born, real, and virtual components but
	also subtraction terms, and a decomposition of the real phase space
	into singular regions. The general idea is that the integration
	results of distinct sets of terms are summed over to provide the
	results of individual components. This is also controlled by the
	[[pcm]] subobject.

	The [[process_status]] object is a bookkeeping device that allows us
	to query the status of an ongoing calculation.

	The [[process_results]] object collects the integration results for
	external use, including integration history information.
	<<Process: public>>=
	public :: process_t
	<<Process: types>>=
	type :: process_t
	private
	type(process_metadata_t) :: &
	meta
	type(process_environment_t) :: &
	env
	type(process_config_data_t) :: &
	config
	class(pcm_t), allocatable :: &
	pcm
	type(process_component_t), dimension(:), allocatable :: &
	component
	type(process_phs_config_t), dimension(:), allocatable :: &
	phs_entry
	type(core_entry_t), dimension(:), allocatable :: &
	core_entry
	type(process_mci_entry_t), dimension(:), allocatable :: &
	mci_entry
	class(rng_factory_t), allocatable :: &
	rng_factory
	type(process_beam_config_t) :: &
	beam_config
	type(process_term_t), dimension(:), allocatable :: &
	term
	type(process_status_t) :: &
	status
	type(process_results_t) :: &
	result
	contains
	<<Process: process: TBP>>
	end type process_t

	@ %def process_t
	@
	\subsection{Process pointer}
	Wrapper type for storing pointers to process objects in arrays.
	<<Process: public>>=
	public :: process_ptr_t
	<<Process: types>>=
	type :: process_ptr_t
	type(process_t), pointer :: p => null ()
	end type process_ptr_t

	@ %def process_ptr_t
	@
	\subsection{Output}
	This procedure is an important debugging and inspection tool; it is
	not used during normal operation. The process object is written
	to a file (identified by unit, which may also be standard output).
	Optional flags determine whether we show everything or just the
	interesting parts.

	The shorthand as a traditional TBP.
	<<Process: process: TBP>>=
	procedure :: write => process_write
	<<Process: sub interfaces>>=
	module subroutine process_write (process, screen, unit, &
	show_os_data, show_var_list, show_rng, show_expressions, pacify)
	class(process_t), intent(in) :: process
	logical, intent(in) :: screen
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_os_data
	logical, intent(in), optional :: show_var_list
	logical, intent(in), optional :: show_rng
	logical, intent(in), optional :: show_expressions
	logical, intent(in), optional :: pacify
	end subroutine process_write
	<<Process: procedures>>=
	module subroutine process_write (process, screen, unit, &
	show_os_data, show_var_list, show_rng, show_expressions, pacify)
	class(process_t), intent(in) :: process
	logical, intent(in) :: screen
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_os_data
	logical, intent(in), optional :: show_var_list
	logical, intent(in), optional :: show_rng
	logical, intent(in), optional :: show_expressions
	logical, intent(in), optional :: pacify
	integer :: u, iostat
	character(0) :: iomsg
	integer, dimension(:), allocatable :: v_list
	u = given_output_unit (unit)
	allocate (v_list (0))
	call set_flag (v_list, F_SHOW_OS_DATA, show_os_data)
	call set_flag (v_list, F_SHOW_VAR_LIST, show_var_list)
	call set_flag (v_list, F_SHOW_RNG, show_rng)
	call set_flag (v_list, F_SHOW_EXPRESSIONS, show_expressions)
	call set_flag (v_list, F_PACIFY, pacify)
	if (screen) then
	call process%write_formatted (u, "LISTDIRECTED", v_list, iostat, iomsg)
	else
	call process%write_formatted (u, "DT", v_list, iostat, iomsg)
	end if
	end subroutine process_write

	@ %def process_write
	@ Standard DTIO procedure with binding.

	For the particular application, the screen format is triggered by the
	[[LISTDIRECTED]] option for the [[iotype]] format editor string. The
	other options activate when the particular parameter value is found in
	[[v_list]].

	NOTE: The DTIO [[generic]] binding is supported by gfortran since 7.0.

	TODO wk 2018: The default could be to show everything, and we should have separate
	switches for all major parts. Currently, there are only a few.
	<<Process: process: TBP>>=
	! generic :: write (formatted) => write_formatted
	procedure :: write_formatted => process_write_formatted
	<<Process: sub interfaces>>=
	module subroutine process_write_formatted (dtv, unit, iotype, &
	v_list, iostat, iomsg)
	class(process_t), intent(in) :: dtv
	integer, intent(in) :: unit
	character(*), intent(in) :: iotype
	integer, dimension(:), intent(in) :: v_list
	integer, intent(out) :: iostat
	character(*), intent(inout) :: iomsg
	end subroutine process_write_formatted
	<<Process: procedures>>=
	module subroutine process_write_formatted (dtv, unit, iotype, &
	v_list, iostat, iomsg)
	class(process_t), intent(in) :: dtv
	integer, intent(in) :: unit
	character(*), intent(in) :: iotype
	integer, dimension(:), intent(in) :: v_list
	integer, intent(out) :: iostat
	character(*), intent(inout) :: iomsg
	integer :: u
	logical :: screen
	logical :: var_list
	logical :: rng_factory
	logical :: expressions
	logical :: counters
	logical :: os_data
	logical :: model
	logical :: pacify
	integer :: i
	u = unit
	select case (iotype)
	case ("LISTDIRECTED")
	screen = .true.
	case default
	screen = .false.
	end select
	var_list = flagged (v_list, F_SHOW_VAR_LIST)
	rng_factory = flagged (v_list, F_SHOW_RNG, .true.)
	expressions = flagged (v_list, F_SHOW_EXPRESSIONS)
	counters = .true.
	os_data = flagged (v_list, F_SHOW_OS_DATA)
	model = .false.
	pacify = flagged (v_list, F_PACIFY)
	associate (process => dtv)
	if (screen) then
	write (msg_buffer, "(A)") repeat ("-", 72)
	call msg_message ()
	else
	call write_separator (u, 2)
	end if
	call process%meta%write (u, screen)
	if (var_list) then
	call process%env%write (u, show_var_list=var_list, &
	show_model=.false., show_lib=.false., &
	show_os_data=os_data)
	else if (.not. screen) then
	write (u, "(1x,A)") "Variable list: [not shown]"
	end if
	if (process%meta%type == PRC_UNKNOWN) then
	call write_separator (u, 2)
	return
	else if (screen) then
	return
	end if
	call write_separator (u)
	call process%config%write (u, counters, model, expressions)
	if (rng_factory) then
	if (allocated (process%rng_factory)) then
	call write_separator (u)
	call process%rng_factory%write (u)
	end if
	end if
	call write_separator (u, 2)
	if (allocated (process%component)) then
	write (u, "(1x,A)") "Process component configuration:"
	do i = 1, size (process%component)
	call write_separator (u)
	call process%component(i)%write (u)
	end do
	else
	write (u, "(1x,A)") "Process component configuration: [undefined]"
	end if
	call write_separator (u, 2)
	if (allocated (process%term)) then
	write (u, "(1x,A)") "Process term configuration:"
	do i = 1, size (process%term)
	call write_separator (u)
	call process%term(i)%write (u)
	end do
	else
	write (u, "(1x,A)") "Process term configuration: [undefined]"
	end if
	call write_separator (u, 2)
	call process%beam_config%write (u)
	call write_separator (u, 2)
	if (allocated (process%mci_entry)) then
	write (u, "(1x,A)") "Multi-channel integrator configurations:"
	do i = 1, size (process%mci_entry)
	call write_separator (u)
	write (u, "(1x,A,I0,A)") "MCI #", i, ":"
	call process%mci_entry(i)%write (u, pacify)
	end do
	end if
	call write_separator (u, 2)
	end associate
	iostat = 0
	iomsg = ""
	end subroutine process_write_formatted

	@ %def process_write_formatted
	@
	<<Process: process: TBP>>=
	procedure :: write_meta => process_write_meta
	<<Process: sub interfaces>>=
	module subroutine process_write_meta (process, unit, testflag)
	class(process_t), intent(in) :: process
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine process_write_meta
	<<Process: procedures>>=
	module subroutine process_write_meta (process, unit, testflag)
	class(process_t), intent(in) :: process
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u, i
	u = given_output_unit (unit)
	select case (process%meta%type)
	case (PRC_UNKNOWN)
	write (u, "(1x,A)") "Process instance [undefined]"
	return
	case (PRC_DECAY)
	write (u, "(1x,A)", advance="no") "Process instance [decay]:"
	case (PRC_SCATTERING)
	write (u, "(1x,A)", advance="no") "Process instance [scattering]:"
	case default
	call msg_bug ("process_instance_write: undefined process type")
	end select
	write (u, "(1x,A,A,A)") "'", char (process%meta%id), "'"
	write (u, "(3x,A,A,A)") "Run ID = '", char (process%meta%run_id), "'"
	if (allocated (process%meta%component_id)) then
	write (u, "(3x,A)") "Process components:"
	do i = 1, size (process%meta%component_id)
	if (process%pcm%component_selected(i)) then
	write (u, "(3x,'*')", advance="no")
	else
	write (u, "(4x)", advance="no")
	end if
	write (u, "(1x,I0,9A)") i, ": '", &
	char (process%meta%component_id (i)), "': ", &
	char (process%meta%component_description (i))
	end do
	end if
	end subroutine process_write_meta

	@ %def process_write_meta
	@ Screen output. Write a short account of the process configuration
	and the current results. The verbose version lists the components,
	the short version just the results.
	<<Process: process: TBP>>=
	procedure :: show => process_show
	<<Process: sub interfaces>>=
	module subroutine process_show (object, unit, verbose)
	class(process_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine process_show
	<<Process: procedures>>=
	module subroutine process_show (object, unit, verbose)
	class(process_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	logical :: verb
	real(default) :: err_percent
	u = given_output_unit (unit)
	verb = .true.; if (present (verbose)) verb = verbose
	if (verb) then
	call object%meta%show (u, object%config%model%get_name ())
	select case (object%meta%type)
	case (PRC_DECAY)
	write (u, "(2x,A)", advance="no") "Computed width ="
	case (PRC_SCATTERING)
	write (u, "(2x,A)", advance="no") "Computed cross section ="
	case default; return
	end select
	else
	if (object%meta%run_id /= "") then
	write (u, "('Run',1x,A,':',1x)", advance="no") &
	char (object%meta%run_id)
	end if
	write (u, "(A)", advance="no") char (object%meta%id)
	select case (object%meta%num_id)
	case (0)
	write (u, "(':')")
	case default
	write (u, "(1x,'(',I0,')',':')") object%meta%num_id
	end select
	write (u, "(2x)", advance="no")
	end if
	if (object%has_integral_tot ()) then
	write (u, "(ES14.7,1x,'+-',ES9.2)", advance="no") &
	object%get_integral_tot (), object%get_error_tot ()
	select case (object%meta%type)
	case (PRC_DECAY)
	write (u, "(1x,A)", advance="no") "GeV"
	case (PRC_SCATTERING)
	write (u, "(1x,A)", advance="no") "fb "
	case default
	write (u, "(1x,A)", advance="no") " "
	end select
	if (object%get_integral_tot () /= 0) then
	err_percent = abs (100 &
	* object%get_error_tot () / object%get_integral_tot ())
	else
	err_percent = 0
	end if
	if (err_percent == 0) then
	write (u, "(1x,'(',F4.0,4x,'%)')") err_percent
	else if (err_percent < 0.1) then
	write (u, "(1x,'(',F7.3,1x,'%)')") err_percent
	else if (err_percent < 1) then
	write (u, "(1x,'(',F6.2,2x,'%)')") err_percent
	else if (err_percent < 10) then
	write (u, "(1x,'(',F5.1,3x,'%)')") err_percent
	else
	write (u, "(1x,'(',F4.0,4x,'%)')") err_percent
	end if
	else
	write (u, "(A)") "[integral undefined]"
	end if
	end subroutine process_show

	@ %def process_show
	@ Finalizer. Explicitly iterate over all subobjects that may contain
	allocated pointers.

	TODO wk 2018 (workaround): The finalizer for the [[config_data]] component is not
	called. The reason is that this deletes model data local to the process,
	but these could be referenced by pointers (flavor objects) from some
	persistent event record. Obviously, such side effects should be avoided, but
	this requires refactoring the event-handling procedures.
	<<Process: process: TBP>>=
	procedure :: final => process_final
	<<Process: sub interfaces>>=
	module subroutine process_final (process)
	class(process_t), intent(inout) :: process
	end subroutine process_final
	<<Process: procedures>>=
	module subroutine process_final (process)
	class(process_t), intent(inout) :: process
	integer :: i
	call process%env%final ()
	if (allocated (process%component)) then
	do i = 1, size (process%component)
	call process%component(i)%final ()
	end do
	end if
	if (allocated (process%term)) then
	do i = 1, size (process%term)
	call process%term(i)%final ()
	end do
	end if
	call process%beam_config%final ()
	if (allocated (process%mci_entry)) then
	do i = 1, size (process%mci_entry)
	call process%mci_entry(i)%final ()
	end do
	end if
	if (allocated (process%pcm)) then
	call process%pcm%final ()
	deallocate (process%pcm)
	end if
	end subroutine process_final

	@ %def process_final
	@
	\subsubsection{Process setup}
	Initialize a process. We need a process library [[lib]] and the process
	identifier [[proc_id]] (string). We will fetch the current run ID from the
	variable list [[var_list]].

	We collect all important data from the environment and store them in the
	appropriate places. OS data, model, and variable list are copied
	into [[env]] (true snapshot), also the process library (pointer only).

	The [[meta]] subobject is initialized with process ID and attributes taken
	from the process library.

	We initialize the [[config]] subobject with all data that are relevant for
	this run, using the settings from [[env]]. These data determine the MD5 sum
	for this run, which allows us to identify the setup and possibly skips in a
	later re-run.

	We also allocate and initialize the embedded RNG factory. We take the seed
	from the [[var_list]], and we should return the [[var_list]] to the caller
	with a new seed.

	Finally, we allocate the process component manager [[pcm]], which implements
	the chosen algorithm for process integration. The first task of the manager
	is to allocate the component array and to determine the component categories
	(e.g., Born/Virtual etc.).

	TODO wk 2018: The [[pcm]] dispatcher should be provided by the caller, if we
	eventually want to eliminate dependencies on concrete [[pcm_t]] extensions.

	Gfortran 7/8/9 bug, has to remain in the main module:
	<<Process: process: TBP>>=
	procedure :: init => process_init
	<<Process: main procedures>>=
	subroutine process_init &
	(process, proc_id, lib, os_data, model, var_list, beam_structure)
	class(process_t), intent(out) :: process
	type(string_t), intent(in) :: proc_id
	type(process_library_t), intent(in), target :: lib
	type(os_data_t), intent(in) :: os_data
	class(model_t), intent(in), target :: model
	type(var_list_t), intent(inout), target, optional :: var_list
	type(beam_structure_t), intent(in), optional :: beam_structure
	integer :: next_rng_seed
	if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, "process_init")
	associate &
	(meta => process%meta, env => process%env, config => process%config)
	call env%init &
	(model, lib, os_data, var_list, beam_structure)
	call meta%init &
	(proc_id, lib, env%get_var_list_ptr ())
	call config%init &
	(meta, env)
	call dispatch_rng_factory &
	(process%rng_factory, env%get_var_list_ptr (), next_rng_seed)
	call update_rng_seed_in_var_list (var_list, next_rng_seed)
	call dispatch_pcm &
	(process%pcm, config%process_def%is_nlo ())
	associate (pcm => process%pcm)
	call pcm%init (env, meta)
	call pcm%allocate_components (process%component, meta)
	call pcm%categorize_components (config)
	end associate
	end associate
	end subroutine process_init

	@ %def process_init
	@
	\subsection{Process component manager}
	The [[pcm]] (read: process-component manager) takes the responsibility of
	steering the actual algorithm of configuration and integration. Depending on
	the concrete type, different algorithms can be implemented.

	The first version of this supports just two implementations: leading-order
	(tree-level) integration and event generation, and NLO (QCD/FKS subtraction).
	We thus can start with a single logical for steering the dispatcher.

	TODO wk 2018: Eventually, we may eliminate all references to the extensions of
	[[pcm_t]] from this module and therefore move this outside the module as well.
	Gfortran 7/8/9 bug, has to be in the main module:
	<<Process: main procedures>>=
	subroutine dispatch_pcm (pcm, is_nlo)
	class(pcm_t), allocatable, intent(out) :: pcm
	logical, intent(in) :: is_nlo
	if (.not. is_nlo) then
	allocate (pcm_default_t :: pcm)
	else
	allocate (pcm_nlo_t :: pcm)
	end if
	end subroutine dispatch_pcm

	@ %def dispatch_pcm
	@ This step is performed after phase-space and core objects are done: collect
	all missing information and prepare the process component manager for the
	appropriate integration algorithm.
	<<Process: process: TBP>>=
	procedure :: complete_pcm_setup => process_complete_pcm_setup
	<<Process: sub interfaces>>=
	module subroutine process_complete_pcm_setup (process)
	class(process_t), intent(inout) :: process
	end subroutine process_complete_pcm_setup
	<<Process: procedures>>=
	module subroutine process_complete_pcm_setup (process)
	class(process_t), intent(inout) :: process
	call process%pcm%complete_setup &
	(process%core_entry, process%component, process%env%get_model_ptr ())
	end subroutine process_complete_pcm_setup

	@ %def process_complete_pcm_setup
	@
	\subsection{Core management}
	Allocate cores (interface objects to matrix-element code).

	The [[dispatch_core]] procedure is taken as an argument, so we do not depend on
	the implementation, and thus on the specific core types.

	The [[helicity_selection]] object collects data that the matrix-element
	code needs for configuring the appropriate behavior.

	After the cores have been allocated, and assuming the phs initial
	configuration has been done before, we proceed with computing the [[pcm]]
	internal data.
	<<Process: process: TBP>>=
	procedure :: setup_cores => process_setup_cores
	<<Process: sub interfaces>>=
	module subroutine process_setup_cores (process, dispatch_core, &
	helicity_selection, use_color_factors, has_beam_pol)
	class(process_t), intent(inout) :: process
	procedure(dispatch_core_proc) :: dispatch_core
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	logical, intent(in), optional :: use_color_factors
	logical, intent(in), optional :: has_beam_pol
	end subroutine process_setup_cores
	<<Process: procedures>>=
	module subroutine process_setup_cores (process, dispatch_core, &
	helicity_selection, use_color_factors, has_beam_pol)
	class(process_t), intent(inout) :: process
	procedure(dispatch_core_proc) :: dispatch_core
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	logical, intent(in), optional :: use_color_factors
	logical, intent(in), optional :: has_beam_pol
	integer :: i
	associate (pcm => process%pcm)
	call pcm%allocate_cores (process%config, process%core_entry)
	do i = 1, size (process%core_entry)
	call dispatch_core (process%core_entry(i)%core, &
	process%core_entry(i)%core_def, &
	process%config%model, &
	helicity_selection, &
	process%config%qcd, &
	use_color_factors, &
	has_beam_pol)
	call process%core_entry(i)%configure &
	(process%env%get_lib_ptr (), process%meta%id)
	if (process%core_entry(i)%core%uses_blha ()) then
	call pcm%setup_blha (process%core_entry(i))
	end if
	end do
	end associate
	end subroutine process_setup_cores

	@ %def process_setup_cores
	<<Process: interfaces>>=
	abstract interface
	subroutine dispatch_core_proc (core, core_def, model, &
	helicity_selection, qcd, use_color_factors, has_beam_pol)
	import
	class(prc_core_t), allocatable, intent(inout) :: core
	class(prc_core_def_t), intent(in) :: core_def
	class(model_data_t), intent(in), target, optional :: model
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	type(qcd_t), intent(in), optional :: qcd
	logical, intent(in), optional :: use_color_factors
	logical, intent(in), optional :: has_beam_pol
	end subroutine dispatch_core_proc
	end interface

	@ %def dispatch_core_proc
	@ Use the [[pcm]] to initialize the BLHA interface for each core which
	requires it.
	<<Process: process: TBP>>=
	procedure :: prepare_blha_cores => process_prepare_blha_cores
	<<Process: sub interfaces>>=
	module subroutine process_prepare_blha_cores (process)
	class(process_t), intent(inout), target :: process
	end subroutine process_prepare_blha_cores
	<<Process: procedures>>=
	module subroutine process_prepare_blha_cores (process)
	class(process_t), intent(inout), target :: process
	integer :: i
	associate (pcm => process%pcm)
	do i = 1, size (process%core_entry)
	associate (core_entry => process%core_entry(i))
	if (core_entry%core%uses_blha ()) then
	pcm%uses_blha = .true.
	call pcm%prepare_blha_core (core_entry, process%config%model)
	end if
	end associate
	end do
	end associate
	end subroutine process_prepare_blha_cores

	@ %def process_prepare_blha_cores
	@ Create the BLHA interface data, using PCM for specific data, and write the
	BLHA contract file(s).

	We take various configuration data and copy them to the [[blha_master]]
	record, which then creates and writes the contracts.

	For assigning the QCD/EW coupling powers, we inspect the first process
	component only. The other parameters are taken as-is from the process
	environment variables.
	<<Process: process: TBP>>=
	procedure :: create_blha_interface => process_create_blha_interface
	<<Process: sub interfaces>>=
	module subroutine process_create_blha_interface (process)
	class(process_t), intent(inout) :: process
	end subroutine process_create_blha_interface
	<<Process: procedures>>=
	module subroutine process_create_blha_interface (process)
	class(process_t), intent(inout) :: process
	integer :: alpha_power, alphas_power
	integer :: openloops_phs_tolerance, openloops_stability_log
	logical :: use_cms
	type(string_t) :: ew_scheme, correction_type
	type(string_t) :: openloops_extra_cmd, openloops_allowed_libs
	type(blha_master_t) :: blha_master
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	if (process%pcm%uses_blha) then
	call collect_configuration_parameters (process%get_var_list_ptr ())
	call process%component(1)%config%get_coupling_powers &
	(alpha_power, alphas_power)
	associate (pcm => process%pcm)
	call pcm%set_blha_methods (blha_master, process%get_var_list_ptr ())
	call blha_master%set_ew_scheme (ew_scheme)
	call blha_master%allocate_config_files ()
	call blha_master%set_correction_type (correction_type)
	call blha_master%setup_additional_features ( &
	openloops_phs_tolerance, &
	use_cms, &
	openloops_stability_log, &
	extra_cmd = openloops_extra_cmd, &
	allowed_libs = openloops_allowed_libs, &
	beam_structure = process%env%get_beam_structure ())
	call pcm%get_blha_flv_states (process%core_entry, flv_born, flv_real)
	call blha_master%set_photon_characteristics (flv_born, process%config%n_in)
	call blha_master%generate (process%meta%id, &
	process%config%model, process%config%n_in, &
	alpha_power, alphas_power, &
	flv_born, flv_real)
	call blha_master%write_olp (process%meta%id)
	end associate
	end if
	contains
	subroutine collect_configuration_parameters (var_list)
	type(var_list_t), intent(in) :: var_list
	openloops_phs_tolerance = &
	var_list%get_ival (var_str ("openloops_phs_tolerance"))
	openloops_stability_log = &
	var_list%get_ival (var_str ("openloops_stability_log"))
	use_cms = &
	var_list%get_lval (var_str ("?openloops_use_cms"))
	ew_scheme = &
	var_list%get_sval (var_str ("$blha_ew_scheme"))
	correction_type = &
	var_list%get_sval (var_str ("$nlo_correction_type"))
	openloops_extra_cmd = &
	var_list%get_sval (var_str ("$openloops_extra_cmd"))
	openloops_allowed_libs = &
	var_list%get_sval (var_str ("$openloops_allowed_libs"))
	end subroutine collect_configuration_parameters
	end subroutine process_create_blha_interface

	@ %def process_create_blha_interface
	@ Initialize the process components, one by one. We require templates for the
	[[mci]] (integrator) and [[phs_config]] (phase-space) configuration data.

	The [[active]] flag is set if the component has an associated matrix
	element, so we can compute it. The case of no core is a unit-test case.

	The specifics depend on the algorithm and are delegated to the [[pcm]]
	process-component manager.

	The optional [[phs_config]] overrides a pre-generated config array (for unit
	test).
	<<Process: process: TBP>>=
	procedure :: init_components => process_init_components
	<<Process: sub interfaces>>=
	module subroutine process_init_components (process, phs_config)
	class(process_t), intent(inout), target :: process
	class(phs_config_t), allocatable, intent(in), optional :: phs_config
	end subroutine process_init_components
	<<Process: procedures>>=
	module subroutine process_init_components (process, phs_config)
	class(process_t), intent(inout), target :: process
	class(phs_config_t), allocatable, intent(in), optional :: phs_config
	integer :: i, i_core
	class(prc_core_t), pointer :: core
	logical :: active
	associate (pcm => process%pcm)
	do i = 1, pcm%n_components
	i_core = pcm%get_i_core(i)
	if (i_core > 0) then
	core => process%get_core_ptr (i_core)
	active = core%has_matrix_element ()
	else
	active = .true.
	end if
	select type (pcm => process%pcm)
	type is (pcm_nlo_t)
	if (pcm%use_real_partition .and. .not. pcm%use_real_singular) then
	if (pcm%component_type(i) == COMP_REAL_SING) then
	active = .false.
	end if
	end if
	end select
	if (present (phs_config)) then
	call pcm%init_component (process%component(i), &
	i, &
	active, &
	phs_config, &
	process%env, process%meta, process%config)
	else
	call pcm%init_component (process%component(i), &
	i, &
	active, &
	process%phs_entry(pcm%i_phs_config(i))%phs_config, &
	process%env, process%meta, process%config)
	end if
	end do
	end associate
	end subroutine process_init_components

	@ %def process_init_components
	@ If process components have turned out to be inactive, this has to be
	recorded in the [[meta]] block. Delegate to the [[pcm]].
	<<Process: process: TBP>>=
	procedure :: record_inactive_components => process_record_inactive_components
	<<Process: sub interfaces>>=
	module subroutine process_record_inactive_components (process)
	class(process_t), intent(inout) :: process
	end subroutine process_record_inactive_components
	<<Process: procedures>>=
	module subroutine process_record_inactive_components (process)
	class(process_t), intent(inout) :: process
	associate (pcm => process%pcm)
	call pcm%record_inactive_components (process%component, process%meta)
	end associate
	end subroutine process_record_inactive_components

	@ %def process_record_inactive_components
	@ Determine the process terms for each process component.
	<<Process: process: TBP>>=
	procedure :: setup_terms => process_setup_terms
	<<Process: sub interfaces>>=
	module subroutine process_setup_terms (process, with_beams)
	class(process_t), intent(inout), target :: process
	logical, intent(in), optional :: with_beams
	end subroutine process_setup_terms
	<<Process: procedures>>=
	module subroutine process_setup_terms (process, with_beams)
	class(process_t), intent(inout), target :: process
	logical, intent(in), optional :: with_beams
	class(model_data_t), pointer :: model
	integer :: i, j, k, i_term
	integer, dimension(:), allocatable :: n_entry
	integer :: n_components, n_tot
	integer :: i_sub
	type(string_t) :: subtraction_method
	class(prc_core_t), pointer :: core => null ()
	logical :: setup_subtraction_component, singular_real
	logical :: requires_spin_correlations
	integer :: nlo_type_to_fetch, n_emitters
	i_sub = 0
	model => process%config%model
	n_components = process%meta%n_components
	allocate (n_entry (n_components), source = 0)
	do i = 1, n_components
	associate (component => process%component(i))
	if (component%active) then
	n_entry(i) = 1
	if (component%get_nlo_type () == NLO_REAL) then
	select type (pcm => process%pcm)
	type is (pcm_nlo_t)
	if (pcm%component_type(i) /= COMP_REAL_FIN) &
	n_entry(i) = n_entry(i) + pcm%region_data%get_n_phs ()
	end select
	end if
	end if
	end associate
	end do
	n_tot = sum (n_entry)
	allocate (process%term (n_tot))
	k = 0
	if (process%is_nlo_calculation ()) then
	i_sub = process%component(1)%config%get_associated_subtraction ()
	subtraction_method = process%component(i_sub)%config%get_me_method ()
	if (debug_on) call msg_debug2 &
	(D_PROCESS_INTEGRATION, "process_setup_terms: ", subtraction_method)
	end if

	do i = 1, n_components
	associate (component => process%component(i))
	if (.not. component%active) cycle
	allocate (component%i_term (n_entry(i)))
	do j = 1, n_entry(i)
	select type (pcm => process%pcm)
	type is (pcm_nlo_t)
	singular_real = component%get_nlo_type () == NLO_REAL &
	.and. pcm%component_type(i) /= COMP_REAL_FIN
	class default
	singular_real = .false.
	end select
	setup_subtraction_component = singular_real .and. j == n_entry(i)
	i_term = k + j
	component%i_term(j) = i_term
	if (singular_real) then
	process%term(i_term)%i_sub = k + n_entry(i)
	else
	process%term(i_term)%i_sub = 0
	end if
	if (setup_subtraction_component) then
	select type (pcm => process%pcm)
	class is (pcm_nlo_t)
	process%term(i_term)%i_core = pcm%i_core(pcm%i_sub)
	end select
	else
	process%term(i_term)%i_core = process%pcm%get_i_core(i)
	end if

	if (process%term(i_term)%i_core == 0) then
	call msg_bug ("Process '" // char (process%get_id ()) &
	// "': core not found!")
	end if
	core => process%get_core_term (i_term)
	if (i_sub > 0) then
	select type (pcm => process%pcm)
	type is (pcm_nlo_t)
	requires_spin_correlations = &
	pcm%region_data%requires_spin_correlations ()
	n_emitters = pcm%region_data%get_n_emitters_sc ()
	class default
	requires_spin_correlations = .false.
	n_emitters = 0
	end select
	if (requires_spin_correlations) then
	call process%term(i_term)%init ( &
	i_term, i, j, core, model, &
	nlo_type = component%config%get_nlo_type (), &
	use_beam_pol = with_beams, &
	subtraction_method = subtraction_method, &
	has_pdfs = process%pcm%has_pdfs, &
	n_emitters = n_emitters)
	else
	call process%term(i_term)%init ( &
	i_term, i, j, core, model, &
	nlo_type = component%config%get_nlo_type (), &
	use_beam_pol = with_beams, &
	subtraction_method = subtraction_method, &
	has_pdfs = process%pcm%has_pdfs)
	end if
	else
	call process%term(i_term)%init ( &
	i_term, i, j, core, model, &
	nlo_type = component%config%get_nlo_type (), &
	use_beam_pol = with_beams, &
	has_pdfs = process%pcm%has_pdfs)
	end if
	end do
	end associate
	k = k + n_entry(i)
	end do
	process%config%n_terms = n_tot
	end subroutine process_setup_terms

	@ %def process_setup_terms
	@ Initialize the beam setup. This is the trivial version where the
	incoming state of the matrix element coincides with the initial state
	of the process. For a scattering process, we need the c.m. energy,
	all other variables are set to their default values (no polarization,
	lab frame and c.m.\ frame coincide, etc.)

	We assume that all components consistently describe a scattering
	process, i.e., two incoming particles.

	Note: The current layout of the [[beam_data_t]] record requires that the
	flavor for each beam is unique. For processes with multiple
	flavors in the initial state, one has to set up beams explicitly.
	This restriction could be removed by extending the code in the
	[[beams]] module.
	<<Process: process: TBP>>=
	procedure :: setup_beams_sqrts => process_setup_beams_sqrts
	<<Process: sub interfaces>>=
	module subroutine process_setup_beams_sqrts &
	(process, sqrts, beam_structure, i_core)
	class(process_t), intent(inout) :: process
	real(default), intent(in) :: sqrts
	type(beam_structure_t), intent(in), optional :: beam_structure
	integer, intent(in), optional :: i_core
	end subroutine process_setup_beams_sqrts
	<<Process: procedures>>=
	module subroutine process_setup_beams_sqrts &
	(process, sqrts, beam_structure, i_core)
	class(process_t), intent(inout) :: process
	real(default), intent(in) :: sqrts
	type(beam_structure_t), intent(in), optional :: beam_structure
	integer, intent(in), optional :: i_core
	type(pdg_array_t), dimension(:,:), allocatable :: pdg_in
	integer, dimension(2) :: pdg_scattering
	type(flavor_t), dimension(2) :: flv_in
	integer :: i, i0, ic
	allocate (pdg_in (2, process%meta%n_components))
	i0 = 0
	do i = 1, process%meta%n_components
	if (process%component(i)%active) then
	if (present (i_core)) then
	ic = i_core
	else
	ic = process%pcm%get_i_core (i)
	end if
	associate (core => process%core_entry(ic)%core)
	pdg_in(:,i) = core%data%get_pdg_in ()
	end associate
	if (i0 == 0) i0 = i
	end if
	end do
	do i = 1, process%meta%n_components
	if (.not. process%component(i)%active) then
	pdg_in(:,i) = pdg_in(:,i0)
	end if
	end do
	if (all (pdg_in%get_length () == 1) .and. &
	all (pdg_in(1,:) == pdg_in(1,i0)) .and. &
	all (pdg_in(2,:) == pdg_in(2,i0))) then
	pdg_scattering(:) = pdg_in(:,i0)%get (1)
	call flv_in%init (pdg_scattering, process%config%model)
	call process%beam_config%init_scattering (flv_in, sqrts, beam_structure)
	else
	call msg_fatal ("Setting up process '" // char (process%meta%id) // "':", &
	[var_str (" --------------------------------------------"), &
	var_str ("Inconsistent initial state. This happens if either "), &
	var_str ("several processes with non-matching initial states "), &
	var_str ("have been added, or for a single process with an "), &
	var_str ("initial state flavor sum. In that case, please set beams "), &
	var_str ("explicitly [singling out a flavor / structure function.]")])
	end if
	end subroutine process_setup_beams_sqrts

	@ %def process_setup_beams_sqrts
	@ This is the version that applies to decay processes. The energy is the
	particle mass, hence no extra argument.
	<<Process: process: TBP>>=
	procedure :: setup_beams_decay => process_setup_beams_decay
	<<Process: sub interfaces>>=
	module subroutine process_setup_beams_decay &
	(process, rest_frame, beam_structure, i_core)
	class(process_t), intent(inout), target :: process
	logical, intent(in), optional :: rest_frame
	type(beam_structure_t), intent(in), optional :: beam_structure
	integer, intent(in), optional :: i_core
	end subroutine process_setup_beams_decay
	<<Process: procedures>>=
	module subroutine process_setup_beams_decay &
	(process, rest_frame, beam_structure, i_core)
	class(process_t), intent(inout), target :: process
	logical, intent(in), optional :: rest_frame
	type(beam_structure_t), intent(in), optional :: beam_structure
	integer, intent(in), optional :: i_core
	type(pdg_array_t), dimension(:,:), allocatable :: pdg_in
	integer, dimension(1) :: pdg_decay
	type(flavor_t), dimension(1) :: flv_in
	integer :: i, i0, ic
	allocate (pdg_in (1, process%meta%n_components))
	i0 = 0
	do i = 1, process%meta%n_components
	if (process%component(i)%active) then
	if (present (i_core)) then
	ic = i_core
	else
	ic = process%pcm%get_i_core (i)
	end if
	associate (core => process%core_entry(ic)%core)
	pdg_in(:,i) = core%data%get_pdg_in ()
	end associate
	if (i0 == 0) i0 = i
	end if
	end do
	do i = 1, process%meta%n_components
	if (.not. process%component(i)%active) then
	pdg_in(:,i) = pdg_in(:,i0)
	end if
	end do
	if (all (pdg_in%get_length () == 1) &
	.and. all (pdg_in(1,:) == pdg_in(1,i0))) then
	pdg_decay(:) = pdg_in(:,i0)%get (1)
	call flv_in%init (pdg_decay, process%config%model)
	call process%beam_config%init_decay (flv_in, rest_frame, beam_structure)
	else
	call msg_fatal ("Setting up decay '" &
	// char (process%meta%id) // "': decaying particle not unique")
	end if
	end subroutine process_setup_beams_decay

	@ %def process_setup_beams_decay
	@ We have to make sure that the masses of the various flavors
	in a given position in the particle string coincide.
	<<Process: process: TBP>>=
	procedure :: check_masses => process_check_masses
	<<Process: sub interfaces>>=
	module subroutine process_check_masses (process)
	class(process_t), intent(in) :: process
	end subroutine process_check_masses
	<<Process: procedures>>=
	module subroutine process_check_masses (process)
	class(process_t), intent(in) :: process
	type(flavor_t), dimension(:), allocatable :: flv
	real(default), dimension(:), allocatable :: mass
	integer :: i, j
	integer :: i_component
	class(prc_core_t), pointer :: core
	do i = 1, process%get_n_terms ()
	i_component = process%term(i)%i_component
	if (.not. process%component(i_component)%active) cycle
	core => process%get_core_term (i)
	associate (data => core%data)
	allocate (flv (data%n_flv), mass (data%n_flv))
	do j = 1, data%n_in + data%n_out
	call flv%init (data%flv_state(j,:), process%config%model)
	mass = flv%get_mass ()
	if (any (.not. nearly_equal(mass, mass(1)))) then
	call msg_fatal ("Process '" // char (process%meta%id) // "': " &
	// "mass values in flavor combination do not coincide. ")
	end if
	end do
	deallocate (flv, mass)
	end associate
	end do
	end subroutine process_check_masses

	@ %def process_check_masses
	@ Set up index mapping for [[region_data]] for singular regions
	equivalent w.r.t. their amplitudes. Has to be called after
	[[region_data]] AND the [[core]] are fully set up. For processes with
	structure function, subprocesses which lead to the same amplitude for
	the hard interaction can differ if structure functions are applied. In
	this case we remap flavor structures to themselves if the eqvivalent
	hard interaction flavor structure has no identical initial state.
	<<Process: process: TBP>>=
	procedure :: optimize_nlo_singular_regions => &
	process_optimize_nlo_singular_regions
	<<Process: sub interfaces>>=
	module subroutine process_optimize_nlo_singular_regions (process)
	class(process_t), intent(inout) :: process
	end subroutine process_optimize_nlo_singular_regions
	<<Process: procedures>>=
	module subroutine process_optimize_nlo_singular_regions (process)
	class(process_t), intent(inout) :: process
	class(prc_core_t), pointer :: core, core_sub
	integer, dimension(:), allocatable :: eqv_flv_index_born
	integer, dimension(:), allocatable :: eqv_flv_index_real
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	integer :: i_flv, i_flv2, n_in, i
	integer :: i_component, i_core, i_core_sub
	logical :: fetched_born, fetched_real
	logical :: optimize
	fetched_born = .false.; fetched_real = .false.
	select type (pcm => process%pcm)
	type is (pcm_nlo_t)
	optimize = pcm%settings%reuse_amplitudes_fks
	if (optimize) then
	do i_component = 1, pcm%n_components
	i_core = pcm%get_i_core(i_component)
	core => process%get_core_ptr (i_core)
	if (.not. core%data_known) cycle
	associate (data => core%data)
	if (pcm%nlo_type_core(i_core) == NLO_REAL .and. &
	.not. pcm%component_type(i_component) == COMP_SUB) then
	if (allocated (core%data%eqv_flv_index)) then
	eqv_flv_index_real = core%get_equivalent_flv_index ()
	fetched_real = .true.
	end if
	i_core_sub = pcm%get_i_core (pcm%i_sub)
	core_sub => process%get_core_ptr (i_core_sub)
	if (allocated (core_sub%data%eqv_flv_index)) then
	eqv_flv_index_born = core_sub%get_equivalent_flv_index ()
	fetched_born = .true.
	end if
	if (fetched_born .and. fetched_real) exit
	end if
	end associate
	end do
	if (.not. fetched_born .or. .not. fetched_real) then
	call msg_warning('Failed to fetch flavor equivalence indices. &
	&Disabling singular region optimization')
	optimize = .false.
	eqv_flv_index_born = [(i, i = 1, pcm%region_data%n_flv_born)]
	eqv_flv_index_real = [(i, i = 1, pcm%region_data%n_flv_real)]
	end if
	if (optimize .and. pcm%has_pdfs) then
	flv_born = pcm%region_data%get_flv_states_born ()
	flv_real = pcm%region_data%get_flv_states_real ()
	n_in = pcm%region_data%n_in
	do i_flv = 1, size (eqv_flv_index_born)
	do i_flv2 = 1, i_flv
	if (any (flv_born(1:n_in, eqv_flv_index_born(i_flv)) /= &
	flv_born(1:n_in, i_flv))) then
	eqv_flv_index_born(i_flv) = i_flv
	exit
	end if
	end do
	end do
	do i_flv = 1, size (eqv_flv_index_real)
	do i_flv2 = 1, i_flv
	if (any (flv_real(1:n_in, eqv_flv_index_real(i_flv)) /= &
	flv_real(1:n_in, i_flv))) then
	eqv_flv_index_real(i_flv) = i_flv
	exit
	end if
	end do
	end do
	end if
	else
	eqv_flv_index_born = [(i, i = 1, pcm%region_data%n_flv_born)]
	eqv_flv_index_real = [(i, i = 1, pcm%region_data%n_flv_real)]
	end if
	pcm%region_data%eqv_flv_index_born = eqv_flv_index_born
	pcm%region_data%eqv_flv_index_real = eqv_flv_index_real
	call pcm%region_data%find_eqv_regions (optimize)
	end select
	end subroutine process_optimize_nlo_singular_regions

	@ %def process_optimize_nlo_singular_regions
	@ For some structure functions we need to get the list of initial
	state flavors. This is a two-dimensional array. The first index is
	the beam index, the second index is the component index. Each array
	element is itself a PDG array object, which consists of the list of
	incoming PDG values for this beam and component.
	<<Process: process: TBP>>=
	procedure :: get_pdg_in => process_get_pdg_in
	<<Process: sub interfaces>>=
	module subroutine process_get_pdg_in (process, pdg_in)
	class(process_t), intent(in), target :: process
	type(pdg_array_t), dimension(:,:), allocatable, intent(out) :: pdg_in
	end subroutine process_get_pdg_in
	<<Process: procedures>>=
	module subroutine process_get_pdg_in (process, pdg_in)
	class(process_t), intent(in), target :: process
	type(pdg_array_t), dimension(:,:), allocatable, intent(out) :: pdg_in
	integer :: i, i_core
	allocate (pdg_in (process%config%n_in, process%meta%n_components))
	do i = 1, process%meta%n_components
	if (process%component(i)%active) then
	i_core = process%pcm%get_i_core (i)
	associate (core => process%core_entry(i_core)%core)
	pdg_in(:,i) = core%data%get_pdg_in ()
	end associate
	end if
	end do
	end subroutine process_get_pdg_in

	@ %def process_get_pdg_in
	@ The phase-space configuration object, in case we need it separately.
	<<Process: process: TBP>>=
	procedure :: get_phs_config => process_get_phs_config
	<<Process: sub interfaces>>=
	module function process_get_phs_config &
	(process, i_component) result (phs_config)
	class(phs_config_t), pointer :: phs_config
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_component
	end function process_get_phs_config
	<<Process: procedures>>=
	module function process_get_phs_config &
	(process, i_component) result (phs_config)
	class(phs_config_t), pointer :: phs_config
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_component
	if (allocated (process%component)) then
	if (process%component(i_component)%active) then
	phs_config => process%component(i_component)%phs_config
	else
	phs_config => null ()
	end if
	else
	phs_config => null ()
	end if
	end function process_get_phs_config

	@ %def process_get_phs_config
	@ The resonance history set can be extracted from the phase-space
	configuration. However, this is only possible if the default phase-space
	method (wood) has been chosen. If [[include_trivial]] is set, we include the
	resonance history with no resonances in the set.
	<<Process: process: TBP>>=
	procedure :: extract_resonance_history_set &
	=> process_extract_resonance_history_set
	<<Process: sub interfaces>>=
	module subroutine process_extract_resonance_history_set &
	(process, res_set, include_trivial, i_component)
	class(process_t), intent(in), target :: process
	type(resonance_history_set_t), intent(out) :: res_set
	logical, intent(in), optional :: include_trivial
	integer, intent(in), optional :: i_component
	end subroutine process_extract_resonance_history_set
	<<Process: procedures>>=
	module subroutine process_extract_resonance_history_set &
	(process, res_set, include_trivial, i_component)
	class(process_t), intent(in), target :: process
	type(resonance_history_set_t), intent(out) :: res_set
	logical, intent(in), optional :: include_trivial
	integer, intent(in), optional :: i_component
	integer :: i
	i = 1; if (present (i_component)) i = i_component
	if (process%component(i)%active) then
	select type (phs_config => process%get_phs_config (i))
	class is (phs_wood_config_t)
	call phs_config%extract_resonance_history_set &
	(res_set, include_trivial)
	class default
	call msg_error ("process '" // char (process%get_id ()) &
	// "': extract resonance histories: phase-space method must be &
	&'wood'. No resonances can be determined.")
	end select
	end if
	end subroutine process_extract_resonance_history_set

	@ %def process_extract_resonance_history_set
	@ Initialize from a complete beam setup. If the beam setup does not
	apply directly to the process, choose a fallback option as a straight
	scattering or decay process.
	<<Process: process: TBP>>=
	procedure :: setup_beams_beam_structure => process_setup_beams_beam_structure
	<<Process: sub interfaces>>=
	module subroutine process_setup_beams_beam_structure &
	(process, beam_structure, sqrts, decay_rest_frame)
	class(process_t), intent(inout) :: process
	type(beam_structure_t), intent(in) :: beam_structure
	real(default), intent(in) :: sqrts
	logical, intent(in), optional :: decay_rest_frame
	end subroutine process_setup_beams_beam_structure
	<<Process: procedures>>=
	module subroutine process_setup_beams_beam_structure &
	(process, beam_structure, sqrts, decay_rest_frame)
	class(process_t), intent(inout) :: process
	type(beam_structure_t), intent(in) :: beam_structure
	real(default), intent(in) :: sqrts
	logical, intent(in), optional :: decay_rest_frame
	integer :: n_in
	logical :: applies
	n_in = process%get_n_in ()
	call beam_structure%check_against_n_in (process%get_n_in (), applies)
	if (applies) then
	call process%beam_config%init_beam_structure &
	(beam_structure, sqrts, process%get_model_ptr (), decay_rest_frame)
	else if (n_in == 2) then
	call process%setup_beams_sqrts (sqrts, beam_structure)
	else
	call process%setup_beams_decay (decay_rest_frame, beam_structure)
	end if
	end subroutine process_setup_beams_beam_structure

	@ %def process_setup_beams_beam_structure
	@ Notify the user about beam setup.
	<<Process: process: TBP>>=
	procedure :: beams_startup_message => process_beams_startup_message
	<<Process: sub interfaces>>=
	module subroutine process_beams_startup_message &
	(process, unit, beam_structure)
	class(process_t), intent(in) :: process
	integer, intent(in), optional :: unit
	type(beam_structure_t), intent(in), optional :: beam_structure
	end subroutine process_beams_startup_message
	<<Process: procedures>>=
	module subroutine process_beams_startup_message &
	(process, unit, beam_structure)
	class(process_t), intent(in) :: process
	integer, intent(in), optional :: unit
	type(beam_structure_t), intent(in), optional :: beam_structure
	call process%beam_config%startup_message (unit, beam_structure)
	end subroutine process_beams_startup_message

	@ %def process_beams_startup_message
	@ Initialize phase-space configuration by reading out the environment
	variables. We return the rebuild flags and store parameters in the blocks
	[[phs_par]] and [[mapping_defs]].

	The phase-space configuration object(s) are allocated by [[pcm]].
	<<Process: process: TBP>>=
	procedure :: init_phs_config => process_init_phs_config
	<<Process: sub interfaces>>=
	module subroutine process_init_phs_config (process)
	class(process_t), intent(inout) :: process
	end subroutine process_init_phs_config
	<<Process: procedures>>=
	module subroutine process_init_phs_config (process)
	class(process_t), intent(inout) :: process

	type(var_list_t), pointer :: var_list
	type(phs_parameters_t) :: phs_par
	type(mapping_defaults_t) :: mapping_defs

	var_list => process%env%get_var_list_ptr ()

	phs_par%m_threshold_s = &
	var_list%get_rval (var_str ("phs_threshold_s"))
	phs_par%m_threshold_t = &
	var_list%get_rval (var_str ("phs_threshold_t"))
	phs_par%off_shell = &
	var_list%get_ival (var_str ("phs_off_shell"))
	phs_par%keep_nonresonant = &
	var_list%get_lval (var_str ("?phs_keep_nonresonant"))
	phs_par%t_channel = &
	var_list%get_ival (var_str ("phs_t_channel"))

	mapping_defs%energy_scale = &
	var_list%get_rval (var_str ("phs_e_scale"))
	mapping_defs%invariant_mass_scale = &
	var_list%get_rval (var_str ("phs_m_scale"))
	mapping_defs%momentum_transfer_scale = &
	var_list%get_rval (var_str ("phs_q_scale"))
	mapping_defs%step_mapping = &
	var_list%get_lval (var_str ("?phs_step_mapping"))
	mapping_defs%step_mapping_exp = &
	var_list%get_lval (var_str ("?phs_step_mapping_exp"))
	mapping_defs%enable_s_mapping = &
	var_list%get_lval (var_str ("?phs_s_mapping"))

	associate (pcm => process%pcm)
	call pcm%init_phs_config (process%phs_entry, &
	process%meta, process%env, phs_par, mapping_defs)
	end associate

	end subroutine process_init_phs_config

	@ %def process_init_phs_config
	@ We complete the kinematics configuration after the beam setup, but before we
	configure the chain of structure functions. The reason is that we need the
	total energy [[sqrts]] for the kinematics, but the structure-function setup
	requires the number of channels, which depends on the kinematics
	configuration. For instance, the kinematics module may return the need for
	parameterizing an s-channel resonance.
	<<Process: process: TBP>>=
	procedure :: configure_phs => process_configure_phs
	<<Process: sub interfaces>>=
	module subroutine process_configure_phs (process, rebuild, &
	ignore_mismatch, combined_integration, subdir)
	class(process_t), intent(inout) :: process
	logical, intent(in), optional :: rebuild
	logical, intent(in), optional :: ignore_mismatch
	logical, intent(in), optional :: combined_integration
	type(string_t), intent(in), optional :: subdir
	end subroutine process_configure_phs
	<<Process: procedures>>=
	module subroutine process_configure_phs (process, rebuild, &
	ignore_mismatch, combined_integration, subdir)
	class(process_t), intent(inout) :: process
	logical, intent(in), optional :: rebuild
	logical, intent(in), optional :: ignore_mismatch
	logical, intent(in), optional :: combined_integration
	type(string_t), intent(in), optional :: subdir
	real(default) :: sqrts
	integer :: i, i_born, nlo_type
	class(phs_config_t), pointer :: phs_config_born
	sqrts = process%get_sqrts ()
	do i = 1, process%meta%n_components
	associate (component => process%component(i))
	if (component%active) then
	select type (pcm => process%pcm)
	type is (pcm_default_t)
	call component%configure_phs (sqrts, process%beam_config, &
	rebuild, ignore_mismatch, subdir)
	class is (pcm_nlo_t)
	nlo_type = component%config%get_nlo_type ()
	select case (nlo_type)
	case (BORN, NLO_VIRTUAL, NLO_SUBTRACTION)
	call component%configure_phs (sqrts, process%beam_config, &
	rebuild, ignore_mismatch, subdir)
	call check_and_extend_phs (component)
	case (NLO_REAL, NLO_MISMATCH, NLO_DGLAP)
	i_born = component%config%get_associated_born ()
	if (pcm%component_type(i) /= COMP_REAL_FIN) &
	call check_and_extend_phs (component)
	call process%component(i_born)%get_phs_config &
	(phs_config_born)
	select type (config => component%phs_config)
	type is (phs_fks_config_t)
	select type (phs_config_born)
	type is (phs_wood_config_t)
	config%md5sum_born_config = &
	phs_config_born%md5sum_phs_config
	call config%set_born_config (phs_config_born)
	call config%set_mode (component%config%get_nlo_type ())
	end select
	end select
	call component%configure_phs (sqrts, &
	process%beam_config, rebuild, ignore_mismatch, subdir)
	end select
	class default
	call msg_bug ("process_configure_phs: unsupported PCM type")
	end select
	end if
	end associate
	end do
	contains
	subroutine check_and_extend_phs (component)
	type(process_component_t), intent(inout) :: component
	if (combined_integration) then
	select type (phs_config => component%phs_config)
	class is (phs_wood_config_t)
	phs_config%is_combined_integration = .true.
	call phs_config%increase_n_par ()
	end select
	end if
	end subroutine check_and_extend_phs
	end subroutine process_configure_phs

	@ %def process_configure_phs
	@
	<<Process: process: TBP>>=
	procedure :: print_phs_startup_message => process_print_phs_startup_message
	<<Process: sub interfaces>>=
	module subroutine process_print_phs_startup_message (process)
	class(process_t), intent(in) :: process
	end subroutine process_print_phs_startup_message
	<<Process: procedures>>=
	module subroutine process_print_phs_startup_message (process)
	class(process_t), intent(in) :: process
	integer :: i_component
	do i_component = 1, process%meta%n_components
	associate (component => process%component(i_component))
	if (component%active) then
	call component%phs_config%startup_message ()
	end if
	end associate
	end do
	end subroutine process_print_phs_startup_message

	@ %def process_print_phs_startup_message
	@ Insert the structure-function configuration data. First allocate the
	storage, then insert data one by one. The third procedure declares a
	mapping (of the MC input parameters) for a specific channel and
	structure-function combination.

	We take the number of channels from the corresponding entry in the
	[[config_data]] section.

	Otherwise, these a simple wrapper routines. The extra level in the
	call tree may allow for simple addressing of multiple concurrent beam
	configurations, not implemented currently.

	If we do not want structure functions, we simply do not call those procedures.
	<<Process: process: TBP>>=
	procedure :: init_sf_chain => process_init_sf_chain
	generic :: set_sf_channel => set_sf_channel_single
	procedure :: set_sf_channel_single => process_set_sf_channel
	generic :: set_sf_channel => set_sf_channel_array
	procedure :: set_sf_channel_array => process_set_sf_channel_array
	<<Process: sub interfaces>>=
	module subroutine process_init_sf_chain (process, sf_config, sf_trace_file)
	class(process_t), intent(inout) :: process
	type(sf_config_t), dimension(:), intent(in) :: sf_config
	type(string_t), intent(in), optional :: sf_trace_file
	end subroutine process_init_sf_chain
	module subroutine process_set_sf_channel (process, c, sf_channel)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: c
	type(sf_channel_t), intent(in) :: sf_channel
	end subroutine process_set_sf_channel
	module subroutine process_set_sf_channel_array (process, sf_channel)
	class(process_t), intent(inout) :: process
	type(sf_channel_t), dimension(:), intent(in) :: sf_channel
	end subroutine process_set_sf_channel_array
	<<Process: procedures>>=
	module subroutine process_init_sf_chain (process, sf_config, sf_trace_file)
	class(process_t), intent(inout) :: process
	type(sf_config_t), dimension(:), intent(in) :: sf_config
	type(string_t), intent(in), optional :: sf_trace_file
	type(string_t) :: file
	if (present (sf_trace_file)) then
	if (sf_trace_file /= "") then
	file = sf_trace_file
	else
	file = process%get_id () // "_sftrace.dat"
	end if
	call process%beam_config%init_sf_chain (sf_config, file)
	else
	call process%beam_config%init_sf_chain (sf_config)
	end if
	end subroutine process_init_sf_chain

	module subroutine process_set_sf_channel (process, c, sf_channel)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: c
	type(sf_channel_t), intent(in) :: sf_channel
	call process%beam_config%set_sf_channel (c, sf_channel)
	end subroutine process_set_sf_channel

	module subroutine process_set_sf_channel_array (process, sf_channel)
	class(process_t), intent(inout) :: process
	type(sf_channel_t), dimension(:), intent(in) :: sf_channel
	integer :: c
	call process%beam_config%allocate_sf_channels (size (sf_channel))
	do c = 1, size (sf_channel)
	call process%beam_config%set_sf_channel (c, sf_channel(c))
	end do
	end subroutine process_set_sf_channel_array

	@ %def process_init_sf_chain
	@ %def process_set_sf_channel
	@ Notify about the structure-function setup.
	<<Process: process: TBP>>=
	procedure :: sf_startup_message => process_sf_startup_message
	<<Process: sub interfaces>>=
	module subroutine process_sf_startup_message (process, sf_string, unit)
	class(process_t), intent(in) :: process
	type(string_t), intent(in) :: sf_string
	integer, intent(in), optional :: unit
	end subroutine process_sf_startup_message
	<<Process: procedures>>=
	module subroutine process_sf_startup_message (process, sf_string, unit)
	class(process_t), intent(in) :: process
	type(string_t), intent(in) :: sf_string
	integer, intent(in), optional :: unit
	call process%beam_config%sf_startup_message (sf_string, unit)
	end subroutine process_sf_startup_message

	@ %def process_sf_startup_message
	@ As soon as both the kinematics configuration and the
	structure-function setup are complete, we match parameterizations
	(channels) for both. The matching entries are (re)set in the
	[[component]] phase-space configuration, while the structure-function
	configuration is left intact.
	<<Process: process: TBP>>=
	procedure :: collect_channels => process_collect_channels
	<<Process: sub interfaces>>=
	module subroutine process_collect_channels (process, coll)
	class(process_t), intent(inout) :: process
	type(phs_channel_collection_t), intent(inout) :: coll
	end subroutine process_collect_channels
	<<Process: procedures>>=
	module subroutine process_collect_channels (process, coll)
	class(process_t), intent(inout) :: process
	type(phs_channel_collection_t), intent(inout) :: coll
	integer :: i
	do i = 1, process%meta%n_components
	associate (component => process%component(i))
	if (component%active) &
	call component%collect_channels (coll)
	end associate
	end do
	end subroutine process_collect_channels

	@ %def process_collect_channels
	@ Independently, we should be able to check if any component does not
	contain phase-space parameters. Such a process can only be integrated
	if there are structure functions.
	<<Process: process: TBP>>=
	procedure :: contains_trivial_component => process_contains_trivial_component
	<<Process: sub interfaces>>=
	module function process_contains_trivial_component (process) result (flag)
	class(process_t), intent(in) :: process
	logical :: flag
	end function process_contains_trivial_component
	<<Process: procedures>>=
	module function process_contains_trivial_component (process) result (flag)
	class(process_t), intent(in) :: process
	logical :: flag
	integer :: i
	flag = .true.
	do i = 1, process%meta%n_components
	associate (component => process%component(i))
	if (component%active) then
	if (component%get_n_phs_par () == 0) return
	end if
	end associate
	end do
	flag = .false.
	end function process_contains_trivial_component

	@ %def process_contains_trivial_component
	@
	<<Process: process: TBP>>=
	procedure :: get_master_component => process_get_master_component
	<<Process: sub interfaces>>=
	module function process_get_master_component &
	(process, i_mci) result (i_component)
	integer :: i_component
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	end function process_get_master_component
	<<Process: procedures>>=
	module function process_get_master_component &
	(process, i_mci) result (i_component)
	integer :: i_component
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	integer :: i
	i_component = 0
	do i = 1, size (process%component)
	if (process%component(i)%i_mci == i_mci) then
	i_component = i
	return
	end if
	end do
	end function process_get_master_component

	@ %def process_get_master_component
	@ Determine the MC parameter set structure and the MCI configuration for each
	process component. We need data from the structure-function and phase-space
	setup, so those should be complete before this is called. We also
	make a random-number generator instance for each MCI group.
	<<Process: process: TBP>>=
	procedure :: setup_mci => process_setup_mci
	<<Process: sub interfaces>>=
	module subroutine process_setup_mci (process, dispatch_mci)
	class(process_t), intent(inout) :: process
	procedure(dispatch_mci_proc) :: dispatch_mci
	end subroutine process_setup_mci
	<<Process: procedures>>=
	module subroutine process_setup_mci (process, dispatch_mci)
	class(process_t), intent(inout) :: process
	procedure(dispatch_mci_proc) :: dispatch_mci
	class(mci_t), allocatable :: mci_template
	integer :: i, i_mci
	if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, "process_setup_mci")
	associate (pcm => process%pcm)
	call pcm%call_dispatch_mci (dispatch_mci, &
	process%get_var_list_ptr (), process%meta%id, mci_template)
	call pcm%setup_mci (process%mci_entry)
	process%config%n_mci = pcm%n_mci
	process%component(:)%i_mci = pcm%i_mci(:)
	do i = 1, pcm%n_components
	i_mci = process%pcm%i_mci(i)
	if (i_mci > 0) then
	associate (component => process%component(i), &
	mci_entry => process%mci_entry(i_mci))
	call mci_entry%configure (mci_template, &
	process%meta%type, &
	i_mci, i, component, process%beam_config%n_sfpar, &
	process%rng_factory)
	call mci_entry%set_parameters (process%get_var_list_ptr ())
	end associate
	end if
	end do
	end associate
	end subroutine process_setup_mci

	@ %def process_setup_mci
	@ Set cuts. This is a parse node, namely the right-hand side of the [[cut]]
	assignment. When creating an instance, we compile this into an evaluation
	tree. The parse node may be null.
	<<Process: process: TBP>>=
	procedure :: set_cuts => process_set_cuts
	<<Process: sub interfaces>>=
	module subroutine process_set_cuts (process, ef_cuts)
	class(process_t), intent(inout) :: process
	class(expr_factory_t), intent(in) :: ef_cuts
	end subroutine process_set_cuts
	<<Process: procedures>>=
	module subroutine process_set_cuts (process, ef_cuts)
	class(process_t), intent(inout) :: process
	class(expr_factory_t), intent(in) :: ef_cuts
	allocate (process%config%ef_cuts, source = ef_cuts)
	end subroutine process_set_cuts

	@ %def process_set_cuts
	@ Analogously for the other expressions.
	<<Process: process: TBP>>=
	procedure :: set_scale => process_set_scale
	procedure :: set_fac_scale => process_set_fac_scale
	procedure :: set_ren_scale => process_set_ren_scale
	procedure :: set_weight => process_set_weight
	<<Process: sub interfaces>>=
	module subroutine process_set_scale (process, ef_scale)
	class(process_t), intent(inout) :: process
	class(expr_factory_t), intent(in) :: ef_scale
	end subroutine process_set_scale
	module subroutine process_set_weight (process, ef_weight)
	class(process_t), intent(inout) :: process
	class(expr_factory_t), intent(in) :: ef_weight
	end subroutine process_set_weight
	module subroutine process_set_fac_scale (process, ef_fac_scale)
	class(process_t), intent(inout) :: process
	class(expr_factory_t), intent(in) :: ef_fac_scale
	end subroutine process_set_fac_scale
	module subroutine process_set_ren_scale (process, ef_ren_scale)
	class(process_t), intent(inout) :: process
	class(expr_factory_t), intent(in) :: ef_ren_scale
	end subroutine process_set_ren_scale
	<<Process: procedures>>=
	module subroutine process_set_scale (process, ef_scale)
	class(process_t), intent(inout) :: process
	class(expr_factory_t), intent(in) :: ef_scale
	allocate (process%config%ef_scale, source = ef_scale)
	end subroutine process_set_scale

	module subroutine process_set_fac_scale (process, ef_fac_scale)
	class(process_t), intent(inout) :: process
	class(expr_factory_t), intent(in) :: ef_fac_scale
	allocate (process%config%ef_fac_scale, source = ef_fac_scale)
	end subroutine process_set_fac_scale

	module subroutine process_set_ren_scale (process, ef_ren_scale)
	class(process_t), intent(inout) :: process
	class(expr_factory_t), intent(in) :: ef_ren_scale
	allocate (process%config%ef_ren_scale, source = ef_ren_scale)
	end subroutine process_set_ren_scale

	module subroutine process_set_weight (process, ef_weight)
	class(process_t), intent(inout) :: process
	class(expr_factory_t), intent(in) :: ef_weight
	allocate (process%config%ef_weight, source = ef_weight)
	end subroutine process_set_weight

	@ %def process_set_scale
	@ %def process_set_fac_scale
	@ %def process_set_ren_scale
	@ %def process_set_weight
	@
	\subsubsection{MD5 sum}
	The MD5 sum of the process object should reflect the state completely,
	including integration results. It is used for checking the integrity
	of event files. This global checksum includes checksums for the
	various parts. In particular, the MCI object receives a checksum that
	includes the configuration of all configuration parts relevant for an
	individual integration. This checksum is used for checking the
	integrity of integration grids.

	We do not need MD5 sums for the process terms, since these are
	generated from the component definitions.
	<<Process: process: TBP>>=
	procedure :: compute_md5sum => process_compute_md5sum
	<<Process: sub interfaces>>=
	module subroutine process_compute_md5sum (process)
	class(process_t), intent(inout) :: process
	end subroutine process_compute_md5sum
	<<Process: procedures>>=
	module subroutine process_compute_md5sum (process)
	class(process_t), intent(inout) :: process
	integer :: i
	call process%config%compute_md5sum ()
	do i = 1, process%config%n_components
	associate (component => process%component(i))
	if (component%active) then
	call component%compute_md5sum ()
	end if
	end associate
	end do
	call process%beam_config%compute_md5sum ()
	do i = 1, process%config%n_mci
	call process%mci_entry(i)%compute_md5sum &
	(process%config, process%component, process%beam_config)
	end do
	end subroutine process_compute_md5sum

	@ %def process_compute_md5sum
	@
	<<Process: process: TBP>>=
	procedure :: sampler_test => process_sampler_test
	<<Process: sub interfaces>>=
	module subroutine process_sampler_test (process, sampler, n_calls, i_mci)
	class(process_t), intent(inout) :: process
	class(mci_sampler_t), intent(inout) :: sampler
	integer, intent(in) :: n_calls, i_mci
	end subroutine process_sampler_test
	<<Process: procedures>>=
	module subroutine process_sampler_test (process, sampler, n_calls, i_mci)
	class(process_t), intent(inout) :: process
	class(mci_sampler_t), intent(inout) :: sampler
	integer, intent(in) :: n_calls, i_mci
	call process%mci_entry(i_mci)%sampler_test (sampler, n_calls)
	end subroutine process_sampler_test

	@ %def process_sampler_test
	@ The finalizer should be called after all integration passes have been
	completed. It will, for instance, write a summary of the integration
	results.

	[[integrate_dummy]] does a ``dummy'' integration in the sense that
	nothing is done but just empty integration results appended.
	<<Process: process: TBP>>=
	procedure :: final_integration => process_final_integration
	procedure :: integrate_dummy => process_integrate_dummy
	<<Process: sub interfaces>>=
	module subroutine process_final_integration (process, i_mci)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	end subroutine process_final_integration
	module subroutine process_integrate_dummy (process)
	class(process_t), intent(inout) :: process
	end subroutine process_integrate_dummy
	<<Process: procedures>>=
	module subroutine process_final_integration (process, i_mci)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	call process%mci_entry(i_mci)%final_integration ()
	end subroutine process_final_integration

	module subroutine process_integrate_dummy (process)
	class(process_t), intent(inout) :: process
	type(integration_results_t) :: results
	integer :: u_log
	u_log = logfile_unit ()
	call results%init (process%meta%type)
	call results%display_init (screen = .true., unit = u_log)
	call results%new_pass ()
	call results%record (1, 0, 0._default, 0._default, 0._default)
	call results%display_final ()
	end subroutine process_integrate_dummy

	@ %def process_final_integration
	@ %def process_integrate_dummy
	@
	<<Process: process: TBP>>=
	procedure :: integrate => process_integrate
	<<Process: sub interfaces>>=
	module subroutine process_integrate (process, i_mci, mci_work, &
	mci_sampler, n_it, n_calls, adapt_grids, adapt_weights, final, &
	pacify, nlo_type)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(mci_work_t), intent(inout) :: mci_work
	class(mci_sampler_t), intent(inout) :: mci_sampler
	integer, intent(in) :: n_it, n_calls
	logical, intent(in), optional :: adapt_grids, adapt_weights
	logical, intent(in), optional :: final
	logical, intent(in), optional :: pacify
	integer, intent(in), optional :: nlo_type
	end subroutine process_integrate
	<<Process: procedures>>=
	module subroutine process_integrate (process, i_mci, mci_work, &
	mci_sampler, n_it, n_calls, adapt_grids, adapt_weights, final, &
	pacify, nlo_type)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(mci_work_t), intent(inout) :: mci_work
	class(mci_sampler_t), intent(inout) :: mci_sampler
	integer, intent(in) :: n_it, n_calls
	logical, intent(in), optional :: adapt_grids, adapt_weights
	logical, intent(in), optional :: final
	logical, intent(in), optional :: pacify
	integer, intent(in), optional :: nlo_type
	associate (mci_entry => process%mci_entry(i_mci))
	call mci_entry%integrate (mci_work%mci, mci_sampler, n_it, n_calls, &
	adapt_grids, adapt_weights, final, pacify, &
	nlo_type = nlo_type)
	call mci_entry%results%display_pass (pacify)
	end associate
	end subroutine process_integrate

	@ %def process_integrate
	@
	<<Process: process: TBP>>=
	procedure :: generate_weighted_event => process_generate_weighted_event
	<<Process: sub interfaces>>=
	module subroutine process_generate_weighted_event (process, i_mci, &
	mci_work, mci_sampler, keep_failed_events)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(mci_work_t), intent(inout) :: mci_work
	class(mci_sampler_t), intent(inout) :: mci_sampler
	logical, intent(in) :: keep_failed_events
	end subroutine process_generate_weighted_event
	<<Process: procedures>>=
	module subroutine process_generate_weighted_event (process, i_mci, &
	mci_work, mci_sampler, keep_failed_events)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(mci_work_t), intent(inout) :: mci_work
	class(mci_sampler_t), intent(inout) :: mci_sampler
	logical, intent(in) :: keep_failed_events
	associate (mci_entry => process%mci_entry(i_mci))
	call mci_entry%generate_weighted_event (mci_work%mci, &
	mci_sampler, keep_failed_events)
	end associate
	end subroutine process_generate_weighted_event

	@ %def process_generate_weighted_event
	<<Process: process: TBP>>=
	procedure :: generate_unweighted_event => process_generate_unweighted_event
	<<Process: sub interfaces>>=
	module subroutine process_generate_unweighted_event (process, i_mci, &
	mci_work, mci_sampler)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(mci_work_t), intent(inout) :: mci_work
	class(mci_sampler_t), intent(inout) :: mci_sampler
	end subroutine process_generate_unweighted_event
	<<Process: procedures>>=
	module subroutine process_generate_unweighted_event (process, i_mci, &
	mci_work, mci_sampler)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(mci_work_t), intent(inout) :: mci_work
	class(mci_sampler_t), intent(inout) :: mci_sampler
	associate (mci_entry => process%mci_entry(i_mci))
	call mci_entry%generate_unweighted_event &
	(mci_work%mci, mci_sampler)
	end associate
	end subroutine process_generate_unweighted_event

	@ %def process_generate_unweighted_event
	@ Display the final results for the sum of all components. This is useful,
	obviously, only if there is more than one component and not if a combined
	integration of all components together has been performed.
	<<Process: process: TBP>>=
	procedure :: display_summed_results => process_display_summed_results
	<<Process: sub interfaces>>=
	module subroutine process_display_summed_results (process, pacify)
	class(process_t), intent(inout) :: process
	logical, intent(in) :: pacify
	end subroutine process_display_summed_results
	<<Process: procedures>>=
	module subroutine process_display_summed_results (process, pacify)
	class(process_t), intent(inout) :: process
	logical, intent(in) :: pacify
	type(integration_results_t) :: results
	integer :: u_log
	u_log = logfile_unit ()
	call results%init (process%meta%type)
	call results%display_init (screen = .true., unit = u_log)
	call results%new_pass ()
	call results%record (1, 0, &
	process%get_integral (), &
	process%get_error (), &
	process%get_efficiency (), suppress = pacify)
	select type (pcm => process%pcm)
	class is (pcm_nlo_t)
	!!! Check that Born integral is there
	if (.not. pcm%settings%combined_integration .and. &
	process%component_can_be_integrated (1)) then
	call results%record_correction (process%get_correction (), &
	process%get_correction_error ())
	end if
	end select
	call results%display_final ()
	end subroutine process_display_summed_results

	@ %def process_display_summed_results
	@ Run LaTeX/Metapost to generate a ps/pdf file for the integration
	history. We (re)write the driver file -- just in case it has been
	missed before -- then we compile it.
	<<Process: process: TBP>>=
	procedure :: display_integration_history => &
	process_display_integration_history
	<<Process: sub interfaces>>=
	module subroutine process_display_integration_history &
	(process, i_mci, filename, os_data, eff_reset)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(string_t), intent(in) :: filename
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: eff_reset
	end subroutine process_display_integration_history
	<<Process: procedures>>=
	module subroutine process_display_integration_history &
	(process, i_mci, filename, os_data, eff_reset)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(string_t), intent(in) :: filename
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: eff_reset
	call integration_results_write_driver &
	(process%mci_entry(i_mci)%results, filename, eff_reset)
	call integration_results_compile_driver &
	(process%mci_entry(i_mci)%results, filename, os_data)
	end subroutine process_display_integration_history

	@ %def subroutine process_display_integration_history
	@ Write a complete logfile (with hardcoded name based on the process ID).
	We do not write internal data.
	<<Process: process: TBP>>=
	procedure :: write_logfile => process_write_logfile
	<<Process: sub interfaces>>=
	module subroutine process_write_logfile (process, i_mci, filename)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(string_t), intent(in) :: filename
	end subroutine process_write_logfile
	<<Process: procedures>>=
	module subroutine process_write_logfile (process, i_mci, filename)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(string_t), intent(in) :: filename
	type(time_t) :: time
	integer :: unit, u
	unit = free_unit ()
	open (unit = unit, file = char (filename), action = "write", &
	status = "replace")
	u = given_output_unit (unit)
	write (u, "(A)") repeat ("#", 79)
	call process%meta%write (u, .false.)
	write (u, "(A)") repeat ("#", 79)
	write (u, "(3x,A,ES17.10)") "Integral = ", &
	process%mci_entry(i_mci)%get_integral ()
	write (u, "(3x,A,ES17.10)") "Error = ", &
	process%mci_entry(i_mci)%get_error ()
	write (u, "(3x,A,ES17.10)") "Accuracy = ", &
	process%mci_entry(i_mci)%get_accuracy ()
	write (u, "(3x,A,ES17.10)") "Chi2 = ", &
	process%mci_entry(i_mci)%get_chi2 ()
	write (u, "(3x,A,ES17.10)") "Efficiency = ", &
	process%mci_entry(i_mci)%get_efficiency ()
	call process%mci_entry(i_mci)%get_time (time, 10000)
	if (time%is_known ()) then
	write (u, "(3x,A,1x,A)") "T(10k evt) = ", char (time%to_string_dhms ())
	else
	write (u, "(3x,A)") "T(10k evt) = [undefined]"
	end if
	call process%mci_entry(i_mci)%results%write (u)
	write (u, "(A)") repeat ("#", 79)
	call process%mci_entry(i_mci)%results%write_chain_weights (u)
	write (u, "(A)") repeat ("#", 79)
	call process%mci_entry(i_mci)%counter%write (u)
	write (u, "(A)") repeat ("#", 79)
	call process%mci_entry(i_mci)%mci%write_log_entry (u)
	write (u, "(A)") repeat ("#", 79)
	call process%beam_config%data%write (u)
	write (u, "(A)") repeat ("#", 79)
	if (allocated (process%config%ef_cuts)) then
	write (u, "(3x,A)") "Cut expression:"
	call process%config%ef_cuts%write (u)
	else
	write (u, "(3x,A)") "No cuts used."
	end if
	call write_separator (u)
	if (allocated (process%config%ef_scale)) then
	write (u, "(3x,A)") "Scale expression:"
	call process%config%ef_scale%write (u)
	else
	write (u, "(3x,A)") "No scale expression was given."
	end if
	call write_separator (u)
	if (allocated (process%config%ef_fac_scale)) then
	write (u, "(3x,A)") "Factorization scale expression:"
	call process%config%ef_fac_scale%write (u)
	else
	write (u, "(3x,A)") "No factorization scale expression was given."
	end if
	call write_separator (u)
	if (allocated (process%config%ef_ren_scale)) then
	write (u, "(3x,A)") "Renormalization scale expression:"
	call process%config%ef_ren_scale%write (u)
	else
	write (u, "(3x,A)") "No renormalization scale expression was given."
	end if
	call write_separator (u)
	if (allocated (process%config%ef_weight)) then
	call write_separator (u)
	write (u, "(3x,A)") "Weight expression:"
	call process%config%ef_weight%write (u)
	else
	write (u, "(3x,A)") "No weight expression was given."
	end if
	write (u, "(A)") repeat ("#", 79)
	write (u, "(1x,A)") "Summary of quantum-number states:"
	write (u, "(1x,A)") " + sign: allowed and contributing"
	write (u, "(1x,A)") " no + : switched off at runtime"
	call process%write_state_summary (u)
	write (u, "(A)") repeat ("#", 79)
	call process%env%write (u, show_var_list=.true., &
	show_model=.false., show_lib=.false., show_os_data=.false.)
	write (u, "(A)") repeat ("#", 79)
	close (u)
	end subroutine process_write_logfile

	@ %def process_write_logfile
	@ Display the quantum-number combinations of the process components, and their
	current status (allowed or switched off).
	<<Process: process: TBP>>=
	procedure :: write_state_summary => process_write_state_summary
	<<Process: sub interfaces>>=
	module subroutine process_write_state_summary (process, unit)
	class(process_t), intent(in) :: process
	integer, intent(in), optional :: unit
	end subroutine process_write_state_summary
	<<Process: procedures>>=
	module subroutine process_write_state_summary (process, unit)
	class(process_t), intent(in) :: process
	integer, intent(in), optional :: unit
	integer :: i, i_component, u
	u = given_output_unit (unit)
	do i = 1, size (process%term)
	call write_separator (u)
	i_component = process%term(i)%i_component
	if (i_component /= 0) then
	call process%term(i)%write_state_summary &
	(process%get_core_term(i), unit)
	end if
	end do
	end subroutine process_write_state_summary

	@ %def process_write_state_summary
	@ Prepare event generation for the specified MCI entry. This implies, in
	particular, checking the phase-space file.
	<<Process: process: TBP>>=
	procedure :: prepare_simulation => process_prepare_simulation
	<<Process: sub interfaces>>=
	module subroutine process_prepare_simulation (process, i_mci)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	end subroutine process_prepare_simulation
	<<Process: procedures>>=
	module subroutine process_prepare_simulation (process, i_mci)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	call process%mci_entry(i_mci)%prepare_simulation ()
	end subroutine process_prepare_simulation

	@ %def process_prepare_simulation
	@
	\subsubsection{Retrieve process data}
	Tell whether integral (and error) are known.
	<<Process: process: TBP>>=
	generic :: has_integral => has_integral_tot, has_integral_mci
	procedure :: has_integral_tot => process_has_integral_tot
	procedure :: has_integral_mci => process_has_integral_mci
	<<Process: sub interfaces>>=
	module function process_has_integral_tot (process) result (flag)
	logical :: flag
	class(process_t), intent(in) :: process
	end function process_has_integral_tot
	module function process_has_integral_mci (process, i_mci) result (flag)
	logical :: flag
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	end function process_has_integral_mci
	<<Process: procedures>>=
	module function process_has_integral_mci (process, i_mci) result (flag)
	logical :: flag
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	if (allocated (process%mci_entry)) then
	flag = process%mci_entry(i_mci)%has_integral ()
	else
	flag = .false.
	end if
	end function process_has_integral_mci

	module function process_has_integral_tot (process) result (flag)
	logical :: flag
	class(process_t), intent(in) :: process
	integer :: i, j, i_component
	if (allocated (process%mci_entry)) then
	flag = .true.
	do i = 1, size (process%mci_entry)
	do j = 1, size (process%mci_entry(i)%i_component)
	i_component = process%mci_entry(i)%i_component(j)
	if (process%component_can_be_integrated (i_component)) &
	flag = flag .and. process%mci_entry(i)%has_integral ()
	end do
	end do
	else
	flag = .false.
	end if
	end function process_has_integral_tot

	@ %def process_has_integral
	@
	Return the current integral and error obtained by the integrator [[i_mci]].
	<<Process: process: TBP>>=
	generic :: get_integral => get_integral_tot, get_integral_mci
	generic :: get_error => get_error_tot, get_error_mci
	generic :: get_efficiency => get_efficiency_tot, get_efficiency_mci
	procedure :: get_integral_tot => process_get_integral_tot
	procedure :: get_integral_mci => process_get_integral_mci
	procedure :: get_error_tot => process_get_error_tot
	procedure :: get_error_mci => process_get_error_mci
	procedure :: get_efficiency_tot => process_get_efficiency_tot
	procedure :: get_efficiency_mci => process_get_efficiency_mci
	<<Process: sub interfaces>>=
	module function process_get_integral_mci (process, i_mci) result (integral)
	real(default) :: integral
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	end function process_get_integral_mci
	module function process_get_error_mci (process, i_mci) result (error)
	real(default) :: error
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	end function process_get_error_mci
	module function process_get_efficiency_mci &
	(process, i_mci) result (efficiency)
	real(default) :: efficiency
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	end function process_get_efficiency_mci
	module function process_get_integral_tot (process) result (integral)
	real(default) :: integral
	class(process_t), intent(in) :: process
	end function process_get_integral_tot
	module function process_get_error_tot (process) result (error)
	real(default) :: variance
	class(process_t), intent(in) :: process
	real(default) :: error
	end function process_get_error_tot
	module function process_get_efficiency_tot (process) result (efficiency)
	real(default) :: efficiency
	class(process_t), intent(in) :: process
	end function process_get_efficiency_tot
	<<Process: procedures>>=
	module function process_get_integral_mci (process, i_mci) result (integral)
	real(default) :: integral
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	integral = process%mci_entry(i_mci)%get_integral ()
	end function process_get_integral_mci

	module function process_get_error_mci (process, i_mci) result (error)
	real(default) :: error
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	error = process%mci_entry(i_mci)%get_error ()
	end function process_get_error_mci

	module function process_get_efficiency_mci &
	(process, i_mci) result (efficiency)
	real(default) :: efficiency
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	efficiency = process%mci_entry(i_mci)%get_efficiency ()
	end function process_get_efficiency_mci

	module function process_get_integral_tot (process) result (integral)
	real(default) :: integral
	class(process_t), intent(in) :: process
	integer :: i, j, i_component
	integral = zero
	if (allocated (process%mci_entry)) then
	do i = 1, size (process%mci_entry)
	do j = 1, size (process%mci_entry(i)%i_component)
	i_component = process%mci_entry(i)%i_component(j)
	if (process%component_can_be_integrated(i_component)) &
	integral = integral + process%mci_entry(i)%get_integral ()
	end do
	end do
	end if
	end function process_get_integral_tot

	module function process_get_error_tot (process) result (error)
	real(default) :: variance
	class(process_t), intent(in) :: process
	real(default) :: error
	integer :: i, j, i_component
	variance = zero
	if (allocated (process%mci_entry)) then
	do i = 1, size (process%mci_entry)
	do j = 1, size (process%mci_entry(i)%i_component)
	i_component = process%mci_entry(i)%i_component(j)
	if (process%component_can_be_integrated(i_component)) &
	variance = variance + process%mci_entry(i)%get_error () ** 2
	end do
	end do
	end if
	error = sqrt (variance)
	end function process_get_error_tot

	module function process_get_efficiency_tot (process) result (efficiency)
	real(default) :: efficiency
	class(process_t), intent(in) :: process
	real(default) :: den, eff, int
	integer :: i, j, i_component
	den = zero
	if (allocated (process%mci_entry)) then
	do i = 1, size (process%mci_entry)
	do j = 1, size (process%mci_entry(i)%i_component)
	i_component = process%mci_entry(i)%i_component(j)
	if (process%component_can_be_integrated(i_component)) then
	int = process%get_integral (i)
	if (int > 0) then
	eff = process%mci_entry(i)%get_efficiency ()
	if (eff > 0) then
	den = den + int / eff
	else
	efficiency = 0
	return
	end if
	end if
	end if
	end do
	end do
	end if
	if (den > 0) then
	efficiency = process%get_integral () / den
	else
	efficiency = 0
	end if
	end function process_get_efficiency_tot

	@ %def process_get_integral process_get_efficiency
	@ Let us call the ratio of the NLO and the LO result $\iota = I_{NLO}
	/ I_{LO}$. Then usual error propagation gives
	\begin{equation*}
	\sigma_{\iota}^2 = \left(\frac{\partial \iota}{\partial
	I_{LO}}\right)^2 \sigma_{I_{LO}}^2
	+ \left(\frac{\partial \iota}{\partial
	I_{NLO}}\right)^2 \sigma_{I_{NLO}}^2
	= \frac{I_{NLO}^2\sigma_{I_{LO}}^2}{I_{LO}^4} +
	\frac{\sigma_{I_{NLO}}^2}{I_{LO}^2}.
	\end{equation*}
	<<Process: process: TBP>>=
	procedure :: get_correction => process_get_correction
	procedure :: get_correction_error => process_get_correction_error
	<<Process: sub interfaces>>=
	module function process_get_correction (process) result (ratio)
	real(default) :: ratio
	class(process_t), intent(in) :: process
	end function process_get_correction
	module function process_get_correction_error (process) result (error)
	real(default) :: error
	class(process_t), intent(in) :: process
	end function process_get_correction_error
	<<Process: procedures>>=
	module function process_get_correction (process) result (ratio)
	real(default) :: ratio
	class(process_t), intent(in) :: process
	integer :: i_mci, i_component
	real(default) :: int_born, int_nlo
	int_nlo = zero
	int_born = process%mci_entry(1)%get_integral ()
	i_mci = 2
	do i_component = 2, size (process%component)
	if (process%component_can_be_integrated (i_component)) then
	int_nlo = int_nlo + process%mci_entry(i_mci)%get_integral ()
	i_mci = i_mci + 1
	end if
	end do
	ratio = int_nlo / int_born * 100
	end function process_get_correction

	module function process_get_correction_error (process) result (error)
	real(default) :: error
	class(process_t), intent(in) :: process
	real(default) :: int_born, sum_int_nlo
	real(default) :: err_born, err2
	integer :: i_mci, i_component
	sum_int_nlo = zero; err2 = zero
	int_born = process%mci_entry(1)%get_integral ()
	err_born = process%mci_entry(1)%get_error ()
	i_mci = 2
	do i_component = 2, size (process%component)
	if (process%component_can_be_integrated (i_component)) then
	sum_int_nlo = sum_int_nlo + process%mci_entry(i_mci)%get_integral ()
	err2 = err2 + process%mci_entry(i_mci)%get_error()**2
	i_mci = i_mci + 1
	end if
	end do
	error = sqrt (err2 / int_born2 + sum_int_nlo2 * err_born2 / int_born4) * 100
	end function process_get_correction_error

	@ %def process_get_correction process_get_correction_error
	@ This routine asks [[beam_config]] for the frame.
	<<Process: process: TBP>>=
	procedure :: lab_is_cm => process_lab_is_cm
	<<Process: sub interfaces>>=
	pure module function process_lab_is_cm (process) result (lab_is_cm)
	logical :: lab_is_cm
	class(process_t), intent(in) :: process
	end function process_lab_is_cm
	<<Process: procedures>>=
	pure module function process_lab_is_cm (process) result (lab_is_cm)
	logical :: lab_is_cm
	class(process_t), intent(in) :: process
	lab_is_cm = process%beam_config%lab_is_cm
	end function process_lab_is_cm

	@ %def process_lab_is_cm
	@
	<<Process: process: TBP>>=
	procedure :: get_component_ptr => process_get_component_ptr
	<<Process: sub interfaces>>=
	module function process_get_component_ptr (process, i) result (component)
	type(process_component_t), pointer :: component
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i
	end function process_get_component_ptr
	<<Process: procedures>>=
	module function process_get_component_ptr (process, i) result (component)
	type(process_component_t), pointer :: component
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i
	component => process%component(i)
	end function process_get_component_ptr

	@ %def process_get_component_ptr
	@
	<<Process: process: TBP>>=
	procedure :: get_qcd => process_get_qcd
	<<Process: sub interfaces>>=
	module function process_get_qcd (process) result (qcd)
	type(qcd_t) :: qcd
	class(process_t), intent(in) :: process
	end function process_get_qcd
	<<Process: procedures>>=
	module function process_get_qcd (process) result (qcd)
	type(qcd_t) :: qcd
	class(process_t), intent(in) :: process
	qcd = process%config%get_qcd ()
	end function process_get_qcd

	@ %def process_get_qcd
	@
	<<Process: process: TBP>>=
	generic :: get_component_type => get_component_type_single
	procedure :: get_component_type_single => process_get_component_type_single
	<<Process: sub interfaces>>=
	elemental module function process_get_component_type_single &
	(process, i_component) result (comp_type)
	integer :: comp_type
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	end function process_get_component_type_single
	<<Process: procedures>>=
	elemental module function process_get_component_type_single &
	(process, i_component) result (comp_type)
	integer :: comp_type
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	comp_type = process%component(i_component)%component_type
	end function process_get_component_type_single

	@ %def process_get_component_type_single
	@
	<<Process: process: TBP>>=
	generic :: get_component_type => get_component_type_all
	procedure :: get_component_type_all => process_get_component_type_all
	<<Process: sub interfaces>>=
	module function process_get_component_type_all &
	(process) result (comp_type)
	integer, dimension(:), allocatable :: comp_type
	class(process_t), intent(in) :: process
	end function process_get_component_type_all
	<<Process: procedures>>=
	module function process_get_component_type_all &
	(process) result (comp_type)
	integer, dimension(:), allocatable :: comp_type
	class(process_t), intent(in) :: process
	allocate (comp_type (size (process%component)))
	comp_type = process%component%component_type
	end function process_get_component_type_all

	@ %def process_get_component_type_all
	@
	<<Process: process: TBP>>=
	procedure :: get_component_i_terms => process_get_component_i_terms
	<<Process: sub interfaces>>=
	module function process_get_component_i_terms &
	(process, i_component) result (i_term)
	integer, dimension(:), allocatable :: i_term
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	end function process_get_component_i_terms
	<<Process: procedures>>=
	module function process_get_component_i_terms &
	(process, i_component) result (i_term)
	integer, dimension(:), allocatable :: i_term
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	allocate (i_term (size (process%component(i_component)%i_term)))
	i_term = process%component(i_component)%i_term
	end function process_get_component_i_terms

	@ %def process_get_component_i_terms
	@
	<<Process: process: TBP>>=
	procedure :: get_n_allowed_born => process_get_n_allowed_born
	<<Process: sub interfaces>>=
	module function process_get_n_allowed_born (process, i_born) result (n_born)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_born
	integer :: n_born
	end function process_get_n_allowed_born
	<<Process: procedures>>=
	module function process_get_n_allowed_born (process, i_born) result (n_born)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_born
	integer :: n_born
	n_born = process%term(i_born)%n_allowed
	end function process_get_n_allowed_born

	@ %def process_get_n_allowed_born
	@ Workaround getter. Would be better to remove this.
	<<Process: process: TBP>>=
	procedure :: get_pcm_ptr => process_get_pcm_ptr
	<<Process: sub interfaces>>=
	module function process_get_pcm_ptr (process) result (pcm)
	class(pcm_t), pointer :: pcm
	class(process_t), intent(in), target :: process
	end function process_get_pcm_ptr
	<<Process: procedures>>=
	module function process_get_pcm_ptr (process) result (pcm)
	class(pcm_t), pointer :: pcm
	class(process_t), intent(in), target :: process
	pcm => process%pcm
	end function process_get_pcm_ptr

	@ %def process_get_pcm_ptr
	<<Process: process: TBP>>=
	generic :: component_can_be_integrated => component_can_be_integrated_single
	generic :: component_can_be_integrated => component_can_be_integrated_all
	procedure :: component_can_be_integrated_single => &
	process_component_can_be_integrated_single
	<<Process: sub interfaces>>=
	module function process_component_can_be_integrated_single &
	(process, i_component) result (active)
	logical :: active
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	end function process_component_can_be_integrated_single
	<<Process: procedures>>=
	module function process_component_can_be_integrated_single &
	(process, i_component) result (active)
	logical :: active
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	logical :: combined_integration
	select type (pcm => process%pcm)
	type is (pcm_nlo_t)
	combined_integration = pcm%settings%combined_integration
	class default
	combined_integration = .false.
	end select
	associate (component => process%component(i_component))
	active = component%can_be_integrated ()
	if (combined_integration) &
	active = active .and. component%component_type <= COMP_MASTER
	end associate
	end function process_component_can_be_integrated_single

	@ %def process_component_can_be_integrated_single
	@
	<<Process: process: TBP>>=
	procedure :: component_can_be_integrated_all => &
	process_component_can_be_integrated_all
	<<Process: sub interfaces>>=
	module function process_component_can_be_integrated_all &
	(process) result (val)
	logical, dimension(:), allocatable :: val
	class(process_t), intent(in) :: process
	end function process_component_can_be_integrated_all
	<<Process: procedures>>=
	module function process_component_can_be_integrated_all (process) result (val)
	logical, dimension(:), allocatable :: val
	class(process_t), intent(in) :: process
	integer :: i
	allocate (val (size (process%component)))
	do i = 1, size (process%component)
	val(i) = process%component_can_be_integrated (i)
	end do
	end function process_component_can_be_integrated_all

	@ %def process_component_can_be_integrated_all
	@
	<<Process: process: TBP>>=
	procedure :: reset_selected_cores => process_reset_selected_cores
	<<Process: sub interfaces>>=
	pure module subroutine process_reset_selected_cores (process)
	class(process_t), intent(inout) :: process
	end subroutine process_reset_selected_cores
	<<Process: procedures>>=
	pure module subroutine process_reset_selected_cores (process)
	class(process_t), intent(inout) :: process
	process%pcm%component_selected = .false.
	end subroutine process_reset_selected_cores

	@ %def process_reset_selected_cores
	@
	<<Process: process: TBP>>=
	procedure :: select_components => process_select_components
	<<Process: sub interfaces>>=
	pure module subroutine process_select_components (process, indices)
	class(process_t), intent(inout) :: process
	integer, dimension(:), intent(in) :: indices
	end subroutine process_select_components
	<<Process: procedures>>=
	pure module subroutine process_select_components (process, indices)
	class(process_t), intent(inout) :: process
	integer, dimension(:), intent(in) :: indices
	associate (pcm => process%pcm)
	pcm%component_selected(indices) = .true.
	end associate
	end subroutine process_select_components

	@ %def process_select_components
	@
	<<Process: process: TBP>>=
	procedure :: component_is_selected => process_component_is_selected
	<<Process: sub interfaces>>=
	pure module function process_component_is_selected &
	(process, index) result (val)
	logical :: val
	class(process_t), intent(in) :: process
	integer, intent(in) :: index
	end function process_component_is_selected
	<<Process: procedures>>=
	pure module function process_component_is_selected &
	(process, index) result (val)
	logical :: val
	class(process_t), intent(in) :: process
	integer, intent(in) :: index
	associate (pcm => process%pcm)
	val = pcm%component_selected(index)
	end associate
	end function process_component_is_selected

	@ %def process_component_is_selected
	@
	<<Process: process: TBP>>=
	procedure :: get_coupling_powers => process_get_coupling_powers
	<<Process: sub interfaces>>=
	pure module subroutine process_get_coupling_powers &
	(process, alpha_power, alphas_power)
	class(process_t), intent(in) :: process
	integer, intent(out) :: alpha_power, alphas_power
	end subroutine process_get_coupling_powers
	<<Process: procedures>>=
	pure module subroutine process_get_coupling_powers &
	(process, alpha_power, alphas_power)
	class(process_t), intent(in) :: process
	integer, intent(out) :: alpha_power, alphas_power
	call process%component(1)%config%get_coupling_powers &
	(alpha_power, alphas_power)
	end subroutine process_get_coupling_powers

	@ %def process_get_coupling_powers
	@
	<<Process: process: TBP>>=
	procedure :: get_real_component => process_get_real_component
	<<Process: sub interfaces>>=
	module function process_get_real_component (process) result (i_real)
	integer :: i_real
	class(process_t), intent(in) :: process
	end function process_get_real_component
	<<Process: procedures>>=
	module function process_get_real_component (process) result (i_real)
	integer :: i_real
	class(process_t), intent(in) :: process
	integer :: i_component
	type(process_component_def_t), pointer :: config => null ()
	i_real = 0
	do i_component = 1, size (process%component)
	config => process%get_component_def_ptr (i_component)
	if (config%get_nlo_type () == NLO_REAL) then
	i_real = i_component
	exit
	end if
	end do
	end function process_get_real_component

	@ %def process_get_real_component
	@
	<<Process: process: TBP>>=
	procedure :: extract_active_component_mci => &
	process_extract_active_component_mci
	<<Process: sub interfaces>>=
	module function process_extract_active_component_mci &
	(process) result (i_active)
	integer :: i_active
	class(process_t), intent(in) :: process
	end function process_extract_active_component_mci
	<<Process: procedures>>=
	module function process_extract_active_component_mci &
	(process) result (i_active)
	integer :: i_active
	class(process_t), intent(in) :: process
	integer :: i_mci, j, i_component, n_active
	call count_n_active ()
	if (n_active /= 1) i_active = 0
	contains
	subroutine count_n_active ()
	n_active = 0
	do i_mci = 1, size (process%mci_entry)
	associate (mci_entry => process%mci_entry(i_mci))
	do j = 1, size (mci_entry%i_component)
	i_component = mci_entry%i_component(j)
	associate (component => process%component (i_component))
	if (component%can_be_integrated ()) then
	i_active = i_mci
	n_active = n_active + 1
	end if
	end associate
	end do
	end associate
	end do
	end subroutine count_n_active
	end function process_extract_active_component_mci

	@ %def process_extract_active_component_mci
	@
	<<Process: process: TBP>>=
	procedure :: uses_real_partition => process_uses_real_partition
	<<Process: sub interfaces>>=
	module function process_uses_real_partition (process) result (val)
	logical :: val
	class(process_t), intent(in) :: process
	end function process_uses_real_partition
	<<Process: procedures>>=
	module function process_uses_real_partition (process) result (val)
	logical :: val
	class(process_t), intent(in) :: process
	val = any (process%mci_entry%real_partition_type /= REAL_FULL)
	end function process_uses_real_partition

	@ %def process_uses_real_partition
	@ Return the MD5 sums that summarize the process component
	definitions. These values should be independent of parameters, beam
	details, expressions, etc. They can be used for checking the
	integrity of a process when reusing an old event file.
	<<Process: process: TBP>>=
	procedure :: get_md5sum_prc => process_get_md5sum_prc
	<<Process: sub interfaces>>=
	module function process_get_md5sum_prc &
	(process, i_component) result (md5sum)
	character(32) :: md5sum
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	end function process_get_md5sum_prc
	<<Process: procedures>>=
	module function process_get_md5sum_prc (process, i_component) result (md5sum)
	character(32) :: md5sum
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	if (process%component(i_component)%active) then
	md5sum = process%component(i_component)%config%get_md5sum ()
	else
	md5sum = ""
	end if
	end function process_get_md5sum_prc

	@ %def process_get_md5sum_prc
	@ Return the MD5 sums that summarize the state of the MCI integrators.
	These values should encode all process data, integration and phase
	space configuration, etc., and the integration results. They can thus
	be used for checking the integrity of an event-generation setup when
	reusing an old event file.
	<<Process: process: TBP>>=
	procedure :: get_md5sum_mci => process_get_md5sum_mci
	<<Process: sub interfaces>>=
	module function process_get_md5sum_mci (process, i_mci) result (md5sum)
	character(32) :: md5sum
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	end function process_get_md5sum_mci
	<<Process: procedures>>=
	module function process_get_md5sum_mci (process, i_mci) result (md5sum)
	character(32) :: md5sum
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	md5sum = process%mci_entry(i_mci)%get_md5sum ()
	end function process_get_md5sum_mci

	@ %def process_get_md5sum_mci
	@ Return the MD5 sum of the process configuration. This should encode
	the process setup, data, and expressions, but no integration results.
	<<Process: process: TBP>>=
	procedure :: get_md5sum_cfg => process_get_md5sum_cfg
	<<Process: sub interfaces>>=
	module function process_get_md5sum_cfg (process) result (md5sum)
	character(32) :: md5sum
	class(process_t), intent(in) :: process
	end function process_get_md5sum_cfg
	<<Process: procedures>>=
	module function process_get_md5sum_cfg (process) result (md5sum)
	character(32) :: md5sum
	class(process_t), intent(in) :: process
	md5sum = process%config%md5sum
	end function process_get_md5sum_cfg

	@ %def process_get_md5sum_cfg
	@
	<<Process: process: TBP>>=
	procedure :: get_n_cores => process_get_n_cores
	<<Process: sub interfaces>>=
	module function process_get_n_cores (process) result (n)
	integer :: n
	class(process_t), intent(in) :: process
	end function process_get_n_cores
	<<Process: procedures>>=
	module function process_get_n_cores (process) result (n)
	integer :: n
	class(process_t), intent(in) :: process
	n = process%pcm%n_cores
	end function process_get_n_cores

	@ %def process_get_n_cores
	@
	<<Process: process: TBP>>=
	procedure :: get_base_i_term => process_get_base_i_term
	<<Process: sub interfaces>>=
	module function process_get_base_i_term &
	(process, i_component) result (i_term)
	integer :: i_term
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	end function process_get_base_i_term
	<<Process: procedures>>=
	module function process_get_base_i_term (process, i_component) result (i_term)
	integer :: i_term
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	i_term = process%component(i_component)%i_term(1)
	end function process_get_base_i_term

	@ %def process_get_base_i_term
	@
	<<Process: process: TBP>>=
	procedure :: get_core_term => process_get_core_term
	<<Process: sub interfaces>>=
	module function process_get_core_term (process, i_term) result (core)
	class(prc_core_t), pointer :: core
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_term
	end function process_get_core_term
	<<Process: procedures>>=
	module function process_get_core_term (process, i_term) result (core)
	class(prc_core_t), pointer :: core
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_term
	integer :: i_core
	i_core = process%term(i_term)%i_core
	core => process%core_entry(i_core)%get_core_ptr ()
	end function process_get_core_term

	@ %def process_get_core_term
	@
	<<Process: process: TBP>>=
	procedure :: get_core_ptr => process_get_core_ptr
	<<Process: sub interfaces>>=
	module function process_get_core_ptr (process, i_core) result (core)
	class(prc_core_t), pointer :: core
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_core
	end function process_get_core_ptr
	<<Process: procedures>>=
	module function process_get_core_ptr (process, i_core) result (core)
	class(prc_core_t), pointer :: core
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_core
	if (allocated (process%core_entry)) then
	core => process%core_entry(i_core)%get_core_ptr ()
	else
	core => null ()
	end if
	end function process_get_core_ptr

	@ %def process_get_core_ptr
	@
	<<Process: process: TBP>>=
	procedure :: get_term_ptr => process_get_term_ptr
	<<Process: sub interfaces>>=
	module function process_get_term_ptr (process, i) result (term)
	type(process_term_t), pointer :: term
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i
	end function process_get_term_ptr
	<<Process: procedures>>=
	module function process_get_term_ptr (process, i) result (term)
	type(process_term_t), pointer :: term
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i
	term => process%term(i)
	end function process_get_term_ptr

	@ %def process_get_term_ptr
	@
	<<Process: process: TBP>>=
	procedure :: get_i_term => process_get_i_term
	<<Process: sub interfaces>>=
	module function process_get_i_term (process, i_core) result (i_term)
	integer :: i_term
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_core
	end function process_get_i_term
	<<Process: procedures>>=
	module function process_get_i_term (process, i_core) result (i_term)
	integer :: i_term
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_core
	do i_term = 1, process%get_n_terms ()
	if (process%term(i_term)%i_core == i_core) return
	end do
	i_term = -1
	end function process_get_i_term

	@ %def process_get_i_term
	@
	<<Process: process: TBP>>=
	procedure :: get_i_core => process_get_i_core
	<<Process: sub interfaces>>=
	module function process_get_i_core (process, i_term) result (i_core)
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_term
	integer :: i_core
	end function process_get_i_core
	<<Process: procedures>>=
	module function process_get_i_core (process, i_term) result (i_core)
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_term
	integer :: i_core
	i_core = process%term(i_term)%i_core
	end function process_get_i_core

	@ %def process_get_i_core
	@
	<<Process: process: TBP>>=
	procedure :: set_i_mci_work => process_set_i_mci_work
	<<Process: sub interfaces>>=
	module subroutine process_set_i_mci_work (process, i_mci)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	end subroutine process_set_i_mci_work
	<<Process: procedures>>=
	module subroutine process_set_i_mci_work (process, i_mci)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	process%mci_entry(i_mci)%i_mci = i_mci
	end subroutine process_set_i_mci_work

	@ %def process_set_i_mci_work
	@
	<<Process: process: TBP>>=
	procedure :: get_i_mci_work => process_get_i_mci_work
	<<Process: sub interfaces>>=
	pure module function process_get_i_mci_work &
	(process, i_mci) result (i_mci_work)
	integer :: i_mci_work
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	end function process_get_i_mci_work
	<<Process: procedures>>=
	pure module function process_get_i_mci_work &
	(process, i_mci) result (i_mci_work)
	integer :: i_mci_work
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	i_mci_work = process%mci_entry(i_mci)%i_mci
	end function process_get_i_mci_work

	@ %def process_get_i_mci_work
	@
	<<Process: process: TBP>>=
	procedure :: get_i_sub => process_get_i_sub
	<<Process: sub interfaces>>=
	elemental module function process_get_i_sub (process, i_term) result (i_sub)
	integer :: i_sub
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_term
	end function process_get_i_sub
	<<Process: procedures>>=
	elemental module function process_get_i_sub (process, i_term) result (i_sub)
	integer :: i_sub
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_term
	i_sub = process%term(i_term)%i_sub
	end function process_get_i_sub

	@ %def process_get_i_sub
	@
	<<Process: process: TBP>>=
	procedure :: get_i_term_virtual => process_get_i_term_virtual
	<<Process: sub interfaces>>=
	elemental module function process_get_i_term_virtual &
	(process) result (i_term)
	integer :: i_term
	class(process_t), intent(in) :: process
	end function process_get_i_term_virtual
	<<Process: procedures>>=
	elemental module function process_get_i_term_virtual (process) result (i_term)
	integer :: i_term
	class(process_t), intent(in) :: process
	integer :: i_component
	i_term = 0
	do i_component = 1, size (process%component)
	if (process%component(i_component)%get_nlo_type () == NLO_VIRTUAL) &
	i_term = process%component(i_component)%i_term(1)
	end do
	end function process_get_i_term_virtual

	@ %def process_get_i_term_virtual
	@
	<<Process: process: TBP>>=
	generic :: component_is_active => component_is_active_single
	procedure :: component_is_active_single => process_component_is_active_single
	<<Process: sub interfaces>>=
	elemental module function process_component_is_active_single &
	(process, i_comp) result (val)
	logical :: val
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_comp
	end function process_component_is_active_single
	<<Process: procedures>>=
	elemental module function process_component_is_active_single &
	(process, i_comp) result (val)
	logical :: val
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_comp
	val = process%component(i_comp)%is_active ()
	end function process_component_is_active_single

	@ %def process_component_is_active_single
	@
	<<Process: process: TBP>>=
	generic :: component_is_active => component_is_active_all
	procedure :: component_is_active_all => process_component_is_active_all
	<<Process: sub interfaces>>=
	pure module function process_component_is_active_all (process) result (val)
	logical, dimension(:), allocatable :: val
	class(process_t), intent(in) :: process
	end function process_component_is_active_all
	<<Process: procedures>>=
	pure module function process_component_is_active_all (process) result (val)
	logical, dimension(:), allocatable :: val
	class(process_t), intent(in) :: process
	allocate (val (size (process%component)))
	val = process%component%is_active ()
	end function process_component_is_active_all

	@ %def process_component_is_active_all
	@
	\subsection{Default iterations}
	If the user does not specify the passes and iterations for
	integration, we should be able to give reasonable defaults. These
	depend on the process, therefore we implement the following procedures
	as methods of the process object. The algorithm is not very
	sophisticated yet, it may be improved by looking at the process in
	more detail.

	We investigate only the first process component, assuming that it
	characterizes the complexity of the process reasonable well.

	The number of passes is limited to two: one for adaption, one for
	integration.
	<<Process: process: TBP>>=
	procedure :: get_n_pass_default => process_get_n_pass_default
	procedure :: adapt_grids_default => process_adapt_grids_default
	procedure :: adapt_weights_default => process_adapt_weights_default
	<<Process: sub interfaces>>=
	module function process_get_n_pass_default (process) result (n_pass)
	class(process_t), intent(in) :: process
	integer :: n_pass
	end function process_get_n_pass_default
	module function process_adapt_grids_default (process, pass) result (flag)
	class(process_t), intent(in) :: process
	integer, intent(in) :: pass
	logical :: flag
	end function process_adapt_grids_default
	module function process_adapt_weights_default (process, pass) result (flag)
	class(process_t), intent(in) :: process
	integer, intent(in) :: pass
	logical :: flag
	end function process_adapt_weights_default
	<<Process: procedures>>=
	module function process_get_n_pass_default (process) result (n_pass)
	class(process_t), intent(in) :: process
	integer :: n_pass
	integer :: n_eff
	type(process_component_def_t), pointer :: config
	config => process%component(1)%config
	n_eff = config%get_n_tot () - 2
	select case (n_eff)
	case (1)
	n_pass = 1
	case default
	n_pass = 2
	end select
	end function process_get_n_pass_default

	module function process_adapt_grids_default (process, pass) result (flag)
	class(process_t), intent(in) :: process
	integer, intent(in) :: pass
	logical :: flag
	integer :: n_eff
	type(process_component_def_t), pointer :: config
	config => process%component(1)%config
	n_eff = config%get_n_tot () - 2
	select case (n_eff)
	case (1)
	flag = .false.
	case default
	select case (pass)
	case (1); flag = .true.
	case (2); flag = .false.
	case default
	call msg_bug ("adapt grids default: impossible pass index")
	end select
	end select
	end function process_adapt_grids_default

	module function process_adapt_weights_default (process, pass) result (flag)
	class(process_t), intent(in) :: process
	integer, intent(in) :: pass
	logical :: flag
	integer :: n_eff
	type(process_component_def_t), pointer :: config
	config => process%component(1)%config
	n_eff = config%get_n_tot () - 2
	select case (n_eff)
	case (1)
	flag = .false.
	case default
	select case (pass)
	case (1); flag = .true.
	case (2); flag = .false.
	case default
	call msg_bug ("adapt weights default: impossible pass index")
	end select
	end select
	end function process_adapt_weights_default

	@ %def process_get_n_pass_default
	@ %def process_adapt_grids_default
	@ %def process_adapt_weights_default
	@ The number of iterations and calls per iteration depends on the
	number of outgoing particles.
	<<Process: process: TBP>>=
	procedure :: get_n_it_default => process_get_n_it_default
	procedure :: get_n_calls_default => process_get_n_calls_default
	<<Process: sub interfaces>>=
	module function process_get_n_it_default (process, pass) result (n_it)
	class(process_t), intent(in) :: process
	integer, intent(in) :: pass
	integer :: n_it
	end function process_get_n_it_default
	module function process_get_n_calls_default (process, pass) result (n_calls)
	class(process_t), intent(in) :: process
	integer, intent(in) :: pass
	integer :: n_calls
	end function process_get_n_calls_default
	<<Process: procedures>>=
	module function process_get_n_it_default (process, pass) result (n_it)
	class(process_t), intent(in) :: process
	integer, intent(in) :: pass
	integer :: n_it
	integer :: n_eff
	type(process_component_def_t), pointer :: config
	config => process%component(1)%config
	n_eff = config%get_n_tot () - 2
	select case (pass)
	case (1)
	select case (n_eff)
	case (1); n_it = 1
	case (2); n_it = 3
	case (3); n_it = 5
	case (4:5); n_it = 10
	case (6); n_it = 15
	case (7:); n_it = 20
	end select
	case (2)
	select case (n_eff)
	case (:3); n_it = 3
	case (4:); n_it = 5
	end select
	end select
	end function process_get_n_it_default

	module function process_get_n_calls_default (process, pass) result (n_calls)
	class(process_t), intent(in) :: process
	integer, intent(in) :: pass
	integer :: n_calls
	integer :: n_eff
	type(process_component_def_t), pointer :: config
	config => process%component(1)%config
	n_eff = config%get_n_tot () - 2
	select case (pass)
	case (1)
	select case (n_eff)
	case (1); n_calls = 100
	case (2); n_calls = 1000
	case (3); n_calls = 5000
	case (4); n_calls = 10000
	case (5); n_calls = 20000
	case (6:); n_calls = 50000
	end select
	case (2)
	select case (n_eff)
	case (:3); n_calls = 10000
	case (4); n_calls = 20000
	case (5); n_calls = 50000
	case (6); n_calls = 100000
	case (7:); n_calls = 200000
	end select
	end select
	end function process_get_n_calls_default

	@ %def process_get_n_it_default
	@ %def process_get_n_calls_default
	@
	\subsection{Constant process data}
	Manually set the Run ID (unit test only).
	<<Process: process: TBP>>=
	procedure :: set_run_id => process_set_run_id
	<<Process: sub interfaces>>=
	module subroutine process_set_run_id (process, run_id)
	class(process_t), intent(inout) :: process
	type(string_t), intent(in) :: run_id
	end subroutine process_set_run_id
	<<Process: procedures>>=
	module subroutine process_set_run_id (process, run_id)
	class(process_t), intent(inout) :: process
	type(string_t), intent(in) :: run_id
	process%meta%run_id = run_id
	end subroutine process_set_run_id

	@ %def process_set_run_id
	@
	The following methods return basic process data that stay constant
	after initialization.

	The process and IDs.
	<<Process: process: TBP>>=
	procedure :: get_id => process_get_id
	procedure :: get_num_id => process_get_num_id
	procedure :: get_run_id => process_get_run_id
	procedure :: get_library_name => process_get_library_name
	<<Process: sub interfaces>>=
	module function process_get_id (process) result (id)
	class(process_t), intent(in) :: process
	type(string_t) :: id
	end function process_get_id
	module function process_get_num_id (process) result (id)
	class(process_t), intent(in) :: process
	integer :: id
	end function process_get_num_id
	module function process_get_run_id (process) result (id)
	class(process_t), intent(in) :: process
	type(string_t) :: id
	end function process_get_run_id
	module function process_get_library_name (process) result (id)
	class(process_t), intent(in) :: process
	type(string_t) :: id
	end function process_get_library_name
	<<Process: procedures>>=
	module function process_get_id (process) result (id)
	class(process_t), intent(in) :: process
	type(string_t) :: id
	id = process%meta%id
	end function process_get_id

	module function process_get_num_id (process) result (id)
	class(process_t), intent(in) :: process
	integer :: id
	id = process%meta%num_id
	end function process_get_num_id

	module function process_get_run_id (process) result (id)
	class(process_t), intent(in) :: process
	type(string_t) :: id
	id = process%meta%run_id
	end function process_get_run_id

	module function process_get_library_name (process) result (id)
	class(process_t), intent(in) :: process
	type(string_t) :: id
	id = process%meta%lib_name
	end function process_get_library_name

	@ %def process_get_id process_get_num_id
	@ %def process_get_run_id process_get_library_name
	@ The number of incoming particles.
	<<Process: process: TBP>>=
	procedure :: get_n_in => process_get_n_in
	<<Process: sub interfaces>>=
	module function process_get_n_in (process) result (n)
	class(process_t), intent(in) :: process
	integer :: n
	end function process_get_n_in
	<<Process: procedures>>=
	module function process_get_n_in (process) result (n)
	class(process_t), intent(in) :: process
	integer :: n
	n = process%config%n_in
	end function process_get_n_in

	@ %def process_get_n_in
	@ The number of MCI data sets.
	<<Process: process: TBP>>=
	procedure :: get_n_mci => process_get_n_mci
	<<Process: sub interfaces>>=
	module function process_get_n_mci (process) result (n)
	class(process_t), intent(in) :: process
	integer :: n
	end function process_get_n_mci
	<<Process: procedures>>=
	module function process_get_n_mci (process) result (n)
	class(process_t), intent(in) :: process
	integer :: n
	n = process%config%n_mci
	end function process_get_n_mci

	@ %def process_get_n_mci
	@ The number of process components, total.
	<<Process: process: TBP>>=
	procedure :: get_n_components => process_get_n_components
	<<Process: sub interfaces>>=
	module function process_get_n_components (process) result (n)
	class(process_t), intent(in) :: process
	integer :: n
	end function process_get_n_components
	<<Process: procedures>>=
	module function process_get_n_components (process) result (n)
	class(process_t), intent(in) :: process
	integer :: n
	n = process%meta%n_components
	end function process_get_n_components

	@ %def process_get_n_components
	@ The number of process terms, total.
	<<Process: process: TBP>>=
	procedure :: get_n_terms => process_get_n_terms
	<<Process: sub interfaces>>=
	module function process_get_n_terms (process) result (n)
	class(process_t), intent(in) :: process
	integer :: n
	end function process_get_n_terms
	<<Process: procedures>>=
	module function process_get_n_terms (process) result (n)
	class(process_t), intent(in) :: process
	integer :: n
	n = process%config%n_terms
	end function process_get_n_terms

	@ %def process_get_n_terms
	@ Return the indices of the components that belong to a
	specific MCI entry.
	<<Process: process: TBP>>=
	procedure :: get_i_component => process_get_i_component
	<<Process: sub interfaces>>=
	module subroutine process_get_i_component (process, i_mci, i_component)
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	integer, dimension(:), intent(out), allocatable :: i_component
	end subroutine process_get_i_component
	<<Process: procedures>>=
	module subroutine process_get_i_component (process, i_mci, i_component)
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	integer, dimension(:), intent(out), allocatable :: i_component
	associate (mci_entry => process%mci_entry(i_mci))
	allocate (i_component (size (mci_entry%i_component)))
	i_component = mci_entry%i_component
	end associate
	end subroutine process_get_i_component

	@ %def process_get_i_component
	@ Return the ID of a specific component.
	<<Process: process: TBP>>=
	procedure :: get_component_id => process_get_component_id
	<<Process: sub interfaces>>=
	module function process_get_component_id (process, i_component) result (id)
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	type(string_t) :: id
	end function process_get_component_id
	<<Process: procedures>>=
	module function process_get_component_id (process, i_component) result (id)
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	type(string_t) :: id
	id = process%meta%component_id(i_component)
	end function process_get_component_id

	@ %def process_get_component_id
	@ Return a pointer to the definition of a specific component.
	<<Process: process: TBP>>=
	procedure :: get_component_def_ptr => process_get_component_def_ptr
	<<Process: sub interfaces>>=
	module function process_get_component_def_ptr &
	(process, i_component) result (ptr)
	type(process_component_def_t), pointer :: ptr
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	end function process_get_component_def_ptr
	<<Process: procedures>>=
	module function process_get_component_def_ptr &
	(process, i_component) result (ptr)
	type(process_component_def_t), pointer :: ptr
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	ptr => process%config%process_def%get_component_def_ptr (i_component)
	end function process_get_component_def_ptr

	@ %def process_get_component_def_ptr
	@ These procedures extract and restore (by transferring the
	allocation) the process core. This is useful for changing process
	parameters from outside this module.
	<<Process: process: TBP>>=
	procedure :: extract_core => process_extract_core
	procedure :: restore_core => process_restore_core
	<<Process: sub interfaces>>=
	module subroutine process_extract_core (process, i_term, core)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_term
	class(prc_core_t), intent(inout), allocatable :: core
	end subroutine process_extract_core
	module subroutine process_restore_core (process, i_term, core)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_term
	class(prc_core_t), intent(inout), allocatable :: core
	end subroutine process_restore_core
	<<Process: procedures>>=
	module subroutine process_extract_core (process, i_term, core)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_term
	class(prc_core_t), intent(inout), allocatable :: core
	integer :: i_core
	i_core = process%term(i_term)%i_core
	call move_alloc (from = process%core_entry(i_core)%core, to = core)
	end subroutine process_extract_core

	module subroutine process_restore_core (process, i_term, core)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_term
	class(prc_core_t), intent(inout), allocatable :: core
	integer :: i_core
	i_core = process%term(i_term)%i_core
	call move_alloc (from = core, to = process%core_entry(i_core)%core)
	end subroutine process_restore_core

	@ %def process_extract_core
	@ %def process_restore_core
	@ The block of process constants.
	<<Process: process: TBP>>=
	procedure :: get_constants => process_get_constants
	<<Process: sub interfaces>>=
	module function process_get_constants (process, i_core) result (data)
	type(process_constants_t) :: data
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_core
	end function process_get_constants
	<<Process: procedures>>=
	module function process_get_constants (process, i_core) result (data)
	type(process_constants_t) :: data
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_core
	data = process%core_entry(i_core)%core%data
	end function process_get_constants

	@ %def process_get_constants
	@
	<<Process: process: TBP>>=
	procedure :: get_config => process_get_config
	<<Process: sub interfaces>>=
	module function process_get_config (process) result (config)
	type(process_config_data_t) :: config
	class(process_t), intent(in) :: process
	end function process_get_config
	<<Process: procedures>>=
	module function process_get_config (process) result (config)
	type(process_config_data_t) :: config
	class(process_t), intent(in) :: process
	config = process%config
	end function process_get_config

	@ %def process_get_config
	@
	Construct an MD5 sum for the constant data, including the NLO type.

	For the NLO type [[NLO_MISMATCH]], we pretend that this was
	[[NLO_SUBTRACTION]] instead.

	TODO wk 2018: should not depend explicitly on NLO data.
	<<Process: process: TBP>>=
	procedure :: get_md5sum_constants => process_get_md5sum_constants
	<<Process: sub interfaces>>=
	module function process_get_md5sum_constants (process, i_component, &
	type_string, nlo_type) result (this_md5sum)
	character(32) :: this_md5sum
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	type(string_t), intent(in) :: type_string
	integer, intent(in) :: nlo_type
	end function process_get_md5sum_constants
	<<Process: procedures>>=
	module function process_get_md5sum_constants (process, i_component, &
	type_string, nlo_type) result (this_md5sum)
	character(32) :: this_md5sum
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	type(string_t), intent(in) :: type_string
	integer, intent(in) :: nlo_type
	type(process_constants_t) :: data
	integer :: unit
	call process%env%fill_process_constants (process%meta%id, i_component, data)
	unit = data%fill_unit_for_md5sum (.false.)
	write (unit, '(A)') char(type_string)
	select case (nlo_type)
	case (NLO_MISMATCH)
	write (unit, '(I0)') NLO_SUBTRACTION
	case default
	write (unit, '(I0)') nlo_type
	end select
	rewind (unit)
	this_md5sum = md5sum (unit)
	close (unit)
	end function process_get_md5sum_constants

	@ %def process_get_md5sum_constants
	@ Return the set of outgoing flavors that are associated with a particular
	term. We deduce this from the effective interaction.
	<<Process: process: TBP>>=
	procedure :: get_term_flv_out => process_get_term_flv_out
	<<Process: sub interfaces>>=
	module subroutine process_get_term_flv_out (process, i_term, flv)
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_term
	type(flavor_t), dimension(:,:), allocatable, intent(out) :: flv
	end subroutine process_get_term_flv_out
	<<Process: procedures>>=
	module subroutine process_get_term_flv_out (process, i_term, flv)
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_term
	type(flavor_t), dimension(:,:), allocatable, intent(out) :: flv
	type(interaction_t), pointer :: int
	int => process%term(i_term)%int_eff
	if (.not. associated (int)) int => process%term(i_term)%int
	call int%get_flv_out (flv)
	end subroutine process_get_term_flv_out

	@ %def process_get_term_flv_out
	@ Return true if there is any unstable particle in any of the process
	terms. We decide this based on the provided model instance, not the
	one that is stored in the process object.
	<<Process: process: TBP>>=
	procedure :: contains_unstable => process_contains_unstable
	<<Process: sub interfaces>>=
	module function process_contains_unstable (process, model) result (flag)
	class(process_t), intent(in) :: process
	class(model_data_t), intent(in), target :: model
	logical :: flag
	end function process_contains_unstable
	<<Process: procedures>>=
	module function process_contains_unstable (process, model) result (flag)
	class(process_t), intent(in) :: process
	class(model_data_t), intent(in), target :: model
	logical :: flag
	integer :: i_term
	type(flavor_t), dimension(:,:), allocatable :: flv
	flag = .false.
	do i_term = 1, process%get_n_terms ()
	call process%get_term_flv_out (i_term, flv)
	call flv%set_model (model)
	flag = .not. all (flv%is_stable ())
	deallocate (flv)
	if (flag) return
	end do
	end function process_contains_unstable

	@ %def process_contains_unstable
	@ The nominal process energy.
	<<Process: process: TBP>>=
	procedure :: get_sqrts => process_get_sqrts
	<<Process: sub interfaces>>=
	module function process_get_sqrts (process) result (sqrts)
	class(process_t), intent(in) :: process
	real(default) :: sqrts
	end function process_get_sqrts
	<<Process: procedures>>=
	module function process_get_sqrts (process) result (sqrts)
	class(process_t), intent(in) :: process
	real(default) :: sqrts
	sqrts = process%beam_config%data%get_sqrts ()
	end function process_get_sqrts

	@ %def process_get_sqrts
	@ The lab-frame beam energy/energies..
	<<Process: process: TBP>>=
	procedure :: get_energy => process_get_energy
	<<Process: sub interfaces>>=
	module function process_get_energy (process) result (e)
	class(process_t), intent(in) :: process
	real(default), dimension(:), allocatable :: e
	end function process_get_energy
	<<Process: procedures>>=
	module function process_get_energy (process) result (e)
	class(process_t), intent(in) :: process
	real(default), dimension(:), allocatable :: e
	e = process%beam_config%data%get_energy ()
	end function process_get_energy

	@ %def process_get_energy
	@ The beam polarization in case of simple degrees.
	<<Process: process: TBP>>=
	procedure :: get_polarization => process_get_polarization
	<<Process: sub interfaces>>=
	module function process_get_polarization (process) result (pol)
	class(process_t), intent(in) :: process
	real(default), dimension(process%beam_config%data%n) :: pol
	end function process_get_polarization
	<<Process: procedures>>=
	module function process_get_polarization (process) result (pol)
	class(process_t), intent(in) :: process
	real(default), dimension(process%beam_config%data%n) :: pol
	pol = process%beam_config%data%get_polarization ()
	end function process_get_polarization

	@ %def process_get_polarization
	@
	<<Process: process: TBP>>=
	procedure :: get_meta => process_get_meta
	<<Process: sub interfaces>>=
	module function process_get_meta (process) result (meta)
	type(process_metadata_t) :: meta
	class(process_t), intent(in) :: process
	end function process_get_meta
	<<Process: procedures>>=
	module function process_get_meta (process) result (meta)
	type(process_metadata_t) :: meta
	class(process_t), intent(in) :: process
	meta = process%meta
	end function process_get_meta

	@ %def process_get_meta
	<<Process: process: TBP>>=
	procedure :: has_matrix_element => process_has_matrix_element
	<<Process: sub interfaces>>=
	module function process_has_matrix_element &
	(process, i, is_term_index) result (active)
	logical :: active
	class(process_t), intent(in) :: process
	integer, intent(in), optional :: i
	logical, intent(in), optional :: is_term_index
	end function process_has_matrix_element
	<<Process: procedures>>=
	module function process_has_matrix_element &
	(process, i, is_term_index) result (active)
	logical :: active
	class(process_t), intent(in) :: process
	integer, intent(in), optional :: i
	logical, intent(in), optional :: is_term_index
	integer :: i_component
	logical :: is_term
	is_term = .false.
	if (present (i)) then
	if (present (is_term_index)) is_term = is_term_index
	if (is_term) then
	i_component = process%term(i)%i_component
	else
	i_component = i
	end if
	active = process%component(i_component)%active
	else
	active = any (process%component%active)
	end if
	end function process_has_matrix_element

	@ %def process_has_matrix_element
	@ Pointer to the beam data object.
	<<Process: process: TBP>>=
	procedure :: get_beam_data_ptr => process_get_beam_data_ptr
	<<Process: sub interfaces>>=
	module function process_get_beam_data_ptr (process) result (beam_data)
	class(process_t), intent(in), target :: process
	type(beam_data_t), pointer :: beam_data
	end function process_get_beam_data_ptr
	<<Process: procedures>>=
	module function process_get_beam_data_ptr (process) result (beam_data)
	class(process_t), intent(in), target :: process
	type(beam_data_t), pointer :: beam_data
	beam_data => process%beam_config%data
	end function process_get_beam_data_ptr

	@ %def process_get_beam_data_ptr
	@
	<<Process: process: TBP>>=
	procedure :: get_beam_config => process_get_beam_config
	<<Process: sub interfaces>>=
	module function process_get_beam_config (process) result (beam_config)
	type(process_beam_config_t) :: beam_config
	class(process_t), intent(in) :: process
	end function process_get_beam_config
	<<Process: procedures>>=
	module function process_get_beam_config (process) result (beam_config)
	type(process_beam_config_t) :: beam_config
	class(process_t), intent(in) :: process
	beam_config = process%beam_config
	end function process_get_beam_config

	@ %def process_get_beam_config
	@
	<<Process: process: TBP>>=
	procedure :: get_beam_config_ptr => process_get_beam_config_ptr
	<<Process: sub interfaces>>=
	module function process_get_beam_config_ptr (process) result (beam_config)
	type(process_beam_config_t), pointer :: beam_config
	class(process_t), intent(in), target :: process
	end function process_get_beam_config_ptr
	<<Process: procedures>>=
	module function process_get_beam_config_ptr (process) result (beam_config)
	type(process_beam_config_t), pointer :: beam_config
	class(process_t), intent(in), target :: process
	beam_config => process%beam_config
	end function process_get_beam_config_ptr

	@ %def process_get_beam_config_ptr
	@ Get the PDF set currently in use, if any.
	<<Process: process: TBP>>=
	procedure :: get_pdf_set => process_get_pdf_set
	<<Process: sub interfaces>>=
	module function process_get_pdf_set (process) result (pdf_set)
	class(process_t), intent(in) :: process
	integer :: pdf_set
	end function process_get_pdf_set
	<<Process: procedures>>=
	module function process_get_pdf_set (process) result (pdf_set)
	class(process_t), intent(in) :: process
	integer :: pdf_set
	pdf_set = process%beam_config%get_pdf_set ()
	end function process_get_pdf_set

	@ %def process_get_pdf_set
	@
	<<Process: process: TBP>>=
	procedure :: pcm_contains_pdfs => process_pcm_contains_pdfs
	<<Process: sub interfaces>>=
	module function process_pcm_contains_pdfs (process) result (has_pdfs)
	logical :: has_pdfs
	class(process_t), intent(in) :: process
	end function process_pcm_contains_pdfs
	<<Process: procedures>>=
	module function process_pcm_contains_pdfs (process) result (has_pdfs)
	logical :: has_pdfs
	class(process_t), intent(in) :: process
	has_pdfs = process%pcm%has_pdfs
	end function process_pcm_contains_pdfs

	@ %def process_pcm_contains_pdfs
	@ Get the beam spectrum file currently in use, if any.
	<<Process: process: TBP>>=
	procedure :: get_beam_file => process_get_beam_file
	<<Process: sub interfaces>>=
	module function process_get_beam_file (process) result (file)
	class(process_t), intent(in) :: process
	type(string_t) :: file
	end function process_get_beam_file
	<<Process: procedures>>=
	module function process_get_beam_file (process) result (file)
	class(process_t), intent(in) :: process
	type(string_t) :: file
	file = process%beam_config%get_beam_file ()
	end function process_get_beam_file

	@ %def process_get_beam_file
	@ Pointer to the process variable list.
	<<Process: process: TBP>>=
	procedure :: get_var_list_ptr => process_get_var_list_ptr
	<<Process: sub interfaces>>=
	module function process_get_var_list_ptr (process) result (ptr)
	class(process_t), intent(in), target :: process
	type(var_list_t), pointer :: ptr
	end function process_get_var_list_ptr
	<<Process: procedures>>=
	module function process_get_var_list_ptr (process) result (ptr)
	class(process_t), intent(in), target :: process
	type(var_list_t), pointer :: ptr
	ptr => process%env%get_var_list_ptr ()
	end function process_get_var_list_ptr

	@ %def process_get_var_list_ptr
	@ Pointer to the common model.
	<<Process: process: TBP>>=
	procedure :: get_model_ptr => process_get_model_ptr
	<<Process: sub interfaces>>=
	module function process_get_model_ptr (process) result (ptr)
	class(process_t), intent(in) :: process
	class(model_data_t), pointer :: ptr
	end function process_get_model_ptr
	<<Process: procedures>>=
	module function process_get_model_ptr (process) result (ptr)
	class(process_t), intent(in) :: process
	class(model_data_t), pointer :: ptr
	ptr => process%config%model
	end function process_get_model_ptr

	@ %def process_get_model_ptr
	@ Use the embedded RNG factory to spawn a new random-number generator
	instance. (This modifies the state of the factory.)
	<<Process: process: TBP>>=
	procedure :: make_rng => process_make_rng
	<<Process: sub interfaces>>=
	module subroutine process_make_rng (process, rng)
	class(process_t), intent(inout) :: process
	class(rng_t), intent(out), allocatable :: rng
	end subroutine process_make_rng
	<<Process: procedures>>=
	module subroutine process_make_rng (process, rng)
	class(process_t), intent(inout) :: process
	class(rng_t), intent(out), allocatable :: rng
	if (allocated (process%rng_factory)) then
	call process%rng_factory%make (rng)
	else
	call msg_bug ("Process: make rng: factory not allocated")
	end if
	end subroutine process_make_rng

	@ %def process_make_rng
	@
	\subsection{Compute an amplitude}
	Each process variant should allow for computing an amplitude value
	directly, without generating a process instance.

	The process component is selected by the index [[i]]. The term within the
	process component is selected by [[j]]. The momentum
	combination is transferred as the array [[p]]. The function sets the specific
	quantum state via the indices of a flavor [[f]], helicity [[h]], and color
	[[c]] combination. Each index refers to the list of flavor, helicity, and
	color states, respectively, as stored in the process data.

	Optionally, we may set factorization and renormalization scale. If unset, the
	partonic c.m.\ energy is inserted.

	The function checks arguments for validity.
	For invalid arguments (quantum states), we return zero.
	<<Process: process: TBP>>=
	procedure :: compute_amplitude => process_compute_amplitude
	<<Process: sub interfaces>>=
	module function process_compute_amplitude (process, i_core, i, j, p, &
	f, h, c, fac_scale, ren_scale, alpha_qcd_forced) result (amp)
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_core
	integer, intent(in) :: i, j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in), optional :: fac_scale, ren_scale
	real(default), intent(in), allocatable, optional :: alpha_qcd_forced
	complex(default) :: amp
	end function process_compute_amplitude
	<<Process: procedures>>=
	module function process_compute_amplitude (process, i_core, i, j, p, &
	f, h, c, fac_scale, ren_scale, alpha_qcd_forced) result (amp)
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_core
	integer, intent(in) :: i, j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in), optional :: fac_scale, ren_scale
	real(default), intent(in), allocatable, optional :: alpha_qcd_forced
	real(default) :: fscale, rscale
	real(default), allocatable :: aqcd_forced
	complex(default) :: amp
	class(prc_core_t), pointer :: core
	amp = 0
	if (0 < i .and. i <= process%meta%n_components) then
	if (process%component(i)%active) then
	associate (core => process%core_entry(i_core)%core)
	associate (data => core%data)
	if (size (p) == data%n_in + data%n_out &
	.and. 0 < f .and. f <= data%n_flv &
	.and. 0 < h .and. h <= data%n_hel &
	.and. 0 < c .and. c <= data%n_col) then
	if (present (fac_scale)) then
	fscale = fac_scale
	else
	fscale = sum (p(data%n_in+1:)) ** 1
	end if
	if (present (ren_scale)) then
	rscale = ren_scale
	else
	rscale = fscale
	end if
	if (present (alpha_qcd_forced)) then
	if (allocated (alpha_qcd_forced)) &
	allocate (aqcd_forced, source = alpha_qcd_forced)
	end if
	amp = core%compute_amplitude (j, p, f, h, c, &
	fscale, rscale, aqcd_forced)
	end if
	end associate
	end associate
	else
	amp = 0
	end if
	end if
	end function process_compute_amplitude

	@ %def process_compute_amplitude
	@ Sanity check for the process library. We abort the program if it
	has changed after process initialization.
	<<Process: process: TBP>>=
	procedure :: check_library_sanity => process_check_library_sanity
	<<Process: sub interfaces>>=
	module subroutine process_check_library_sanity (process)
	class(process_t), intent(in) :: process
	end subroutine process_check_library_sanity
	<<Process: procedures>>=
	module subroutine process_check_library_sanity (process)
	class(process_t), intent(in) :: process
	call process%env%check_lib_sanity (process%meta)
	end subroutine process_check_library_sanity

	@ %def process_check_library_sanity
	@ Reset the association to a process library.
	<<Process: process: TBP>>=
	procedure :: reset_library_ptr => process_reset_library_ptr
	<<Process: sub interfaces>>=
	module subroutine process_reset_library_ptr (process)
	class(process_t), intent(inout) :: process
	end subroutine process_reset_library_ptr
	<<Process: procedures>>=
	module subroutine process_reset_library_ptr (process)
	class(process_t), intent(inout) :: process
	call process%env%reset_lib_ptr ()
	end subroutine process_reset_library_ptr

	@ %def process_reset_library_ptr
	@
	<<Process: process: TBP>>=
	procedure :: set_counter_mci_entry => process_set_counter_mci_entry
	<<Process: sub interfaces>>=
	module subroutine process_set_counter_mci_entry (process, i_mci, counter)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(process_counter_t), intent(in) :: counter
	end subroutine process_set_counter_mci_entry
	<<Process: procedures>>=
	module subroutine process_set_counter_mci_entry (process, i_mci, counter)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_mci
	type(process_counter_t), intent(in) :: counter
	process%mci_entry(i_mci)%counter = counter
	end subroutine process_set_counter_mci_entry

	@ %def process_set_counter_mci_entry
	@ This is for suppression of numerical noise in the integration results
	stored in the [[process_mci_entry]] type. As the error and efficiency
	enter the MD5 sum, we recompute it.
	<<Process: process: TBP>>=
	procedure :: pacify => process_pacify
	<<Process: sub interfaces>>=
	module subroutine process_pacify (process, efficiency_reset, error_reset)
	class(process_t), intent(inout) :: process
	logical, intent(in), optional :: efficiency_reset, error_reset
	end subroutine process_pacify
	<<Process: procedures>>=
	module subroutine process_pacify (process, efficiency_reset, error_reset)
	class(process_t), intent(inout) :: process
	logical, intent(in), optional :: efficiency_reset, error_reset
	logical :: eff_reset, err_reset
	integer :: i
	eff_reset = .false.
	err_reset = .false.
	if (present (efficiency_reset)) eff_reset = efficiency_reset
	if (present (error_reset)) err_reset = error_reset
	if (allocated (process%mci_entry)) then
	do i = 1, size (process%mci_entry)
	call process%mci_entry(i)%results%pacify (efficiency_reset)
	if (allocated (process%mci_entry(i)%mci)) then
	associate (mci => process%mci_entry(i)%mci)
	if (process%mci_entry(i)%mci%error_known &
	.and. err_reset) &
	mci%error = 0
	if (process%mci_entry(i)%mci%efficiency_known &
	.and. eff_reset) &
	mci%efficiency = 1
	call mci%pacify (efficiency_reset, error_reset)
	call mci%compute_md5sum ()
	end associate
	end if
	end do
	end if
	end subroutine process_pacify

	@ %def process_pacify
	@ The following methods are used only in the unit tests; the access
	process internals directly that would otherwise be hidden.
	<<Process: process: TBP>>=
	procedure :: test_allocate_sf_channels
	procedure :: test_set_component_sf_channel
	procedure :: test_get_mci_ptr
	<<Process: sub interfaces>>=
	module subroutine test_allocate_sf_channels (process, n)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: n
	end subroutine test_allocate_sf_channels
	module subroutine test_set_component_sf_channel (process, c)
	class(process_t), intent(inout) :: process
	integer, dimension(:), intent(in) :: c
	end subroutine test_set_component_sf_channel
	module subroutine test_get_mci_ptr (process, mci)
	class(process_t), intent(in), target :: process
	class(mci_t), intent(out), pointer :: mci
	end subroutine test_get_mci_ptr
	<<Process: procedures>>=
	module subroutine test_allocate_sf_channels (process, n)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: n
	call process%beam_config%allocate_sf_channels (n)
	end subroutine test_allocate_sf_channels

	module subroutine test_set_component_sf_channel (process, c)
	class(process_t), intent(inout) :: process
	integer, dimension(:), intent(in) :: c
	call process%component(1)%phs_config%set_sf_channel (c)
	end subroutine test_set_component_sf_channel

	module subroutine test_get_mci_ptr (process, mci)
	class(process_t), intent(in), target :: process
	class(mci_t), intent(out), pointer :: mci
	mci => process%mci_entry(1)%mci
	end subroutine test_get_mci_ptr

	@ %def test_allocate_sf_channels
	@ %def test_set_component_sf_channel
	@ %def test_get_mci_ptr
	@
	<<Process: process: TBP>>=
	procedure :: init_mci_work => process_init_mci_work
	<<Process: sub interfaces>>=
	module subroutine process_init_mci_work (process, mci_work, i)
	class(process_t), intent(in), target :: process
	type(mci_work_t), intent(out) :: mci_work
	integer, intent(in) :: i
	end subroutine process_init_mci_work
	<<Process: procedures>>=
	module subroutine process_init_mci_work (process, mci_work, i)
	class(process_t), intent(in), target :: process
	type(mci_work_t), intent(out) :: mci_work
	integer, intent(in) :: i
	call mci_work%init (process%mci_entry(i))
	end subroutine process_init_mci_work

	@ %def process_init_mci_work
	@
	Prepare the process core with type [[test_me]], or otherwise the externally
	provided [[type_string]] version. The toy dispatchers as a procedure
	argument come handy, knowing that we need to support only the [[test_me]] and
	[[template]] matrix-element types.
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<Process: process: TBP>>=
	procedure :: setup_test_cores => process_setup_test_cores
	<<Process: main procedures>>=
	subroutine dispatch_test_me_core (core, core_def, model, &
	helicity_selection, qcd, use_color_factors, has_beam_pol)
	use prc_test_core, only: test_t
	class(prc_core_t), allocatable, intent(inout) :: core
	class(prc_core_def_t), intent(in) :: core_def
	class(model_data_t), intent(in), target, optional :: model
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	type(qcd_t), intent(in), optional :: qcd
	logical, intent(in), optional :: use_color_factors
	logical, intent(in), optional :: has_beam_pol
	allocate (test_t :: core)
	end subroutine dispatch_test_me_core

	subroutine dispatch_template_core (core, core_def, model, &
	helicity_selection, qcd, use_color_factors, has_beam_pol)
	use prc_template_me, only: prc_template_me_t
	class(prc_core_t), allocatable, intent(inout) :: core
	class(prc_core_def_t), intent(in) :: core_def
	class(model_data_t), intent(in), target, optional :: model
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	type(qcd_t), intent(in), optional :: qcd
	logical, intent(in), optional :: use_color_factors
	logical, intent(in), optional :: has_beam_pol
	allocate (prc_template_me_t :: core)
	select type (core)
	type is (prc_template_me_t)
	call core%set_parameters (model)
	end select
	end subroutine dispatch_template_core

	subroutine process_setup_test_cores (process, type_string)
	class(process_t), intent(inout) :: process
	class(prc_core_t), allocatable :: core
	type(string_t), intent(in), optional :: type_string
	if (present (type_string)) then
	select case (char (type_string))
	case ("template")
	call process%setup_cores (dispatch_template_core)
	case ("test_me")
	call process%setup_cores (dispatch_test_me_core)
	case default
	call msg_bug ("process setup test cores: unsupported type string")
	end select
	else
	call process%setup_cores (dispatch_test_me_core)
	end if
	end subroutine process_setup_test_cores

	@ %def process_setup_test_cores
	@
	<<Process: process: TBP>>=
	procedure :: get_connected_states => process_get_connected_states
	<<Process: sub interfaces>>=
	module function process_get_connected_states (process, i_component, &
	connected_terms) result (connected)
	type(connected_state_t), dimension(:), allocatable :: connected
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	type(connected_state_t), dimension(:), intent(in) :: connected_terms
	end function process_get_connected_states
	<<Process: procedures>>=
	module function process_get_connected_states (process, i_component, &
	connected_terms) result (connected)
	type(connected_state_t), dimension(:), allocatable :: connected
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	type(connected_state_t), dimension(:), intent(in) :: connected_terms
	integer :: i, i_conn
	integer :: n_conn
	n_conn = 0
	do i = 1, process%get_n_terms ()
	if (process%term(i)%i_component == i_component) then
	n_conn = n_conn + 1
	end if
	end do
	allocate (connected (n_conn))
	i_conn = 1
	do i = 1, process%get_n_terms ()
	if (process%term(i)%i_component == i_component) then
	connected (i_conn) = connected_terms(i)
	i_conn = i_conn + 1
	end if
	end do
	end function process_get_connected_states

	@ %def process_get_connected_states
	@
	\subsection{NLO specifics}
	These subroutines (and the NLO specific properties they work on) could
	potentially be moved to [[pcm_nlo_t]] and used more generically in
	[[process_t]] with an appropriate interface in [[pcm_t]]

	TODO wk 2018: This is used only by event initialization, which deals
	with an incomplete process object.
	<<Process: process: TBP>>=
	procedure :: init_nlo_settings => process_init_nlo_settings
	<<Process: sub interfaces>>=
	module subroutine process_init_nlo_settings (process, var_list)
	class(process_t), intent(inout) :: process
	type(var_list_t), intent(in), target :: var_list
	end subroutine process_init_nlo_settings
	<<Process: procedures>>=
	module subroutine process_init_nlo_settings (process, var_list)
	class(process_t), intent(inout) :: process
	type(var_list_t), intent(in), target :: var_list
	select type (pcm => process%pcm)
	type is (pcm_nlo_t)
	call pcm%init_nlo_settings (var_list)
	if (debug_active (D_SUBTRACTION) .or. debug_active (D_VIRTUAL)) &
	call pcm%settings%write ()
	class default
	call msg_fatal ("Attempt to set nlo_settings with a non-NLO pcm!")
	end select
	end subroutine process_init_nlo_settings

	@ %def process_init_nlo_settings
	@
	<<Process: process: TBP>>=
	generic :: get_nlo_type_component => get_nlo_type_component_single
	procedure :: get_nlo_type_component_single => &
	process_get_nlo_type_component_single
	<<Process: sub interfaces>>=
	elemental module function process_get_nlo_type_component_single &
	(process, i_component) result (val)
	integer :: val
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	end function process_get_nlo_type_component_single
	<<Process: procedures>>=
	elemental module function process_get_nlo_type_component_single &
	(process, i_component) result (val)
	integer :: val
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	val = process%component(i_component)%get_nlo_type ()
	end function process_get_nlo_type_component_single

	@ %def process_get_nlo_type_component_single
	@
	<<Process: process: TBP>>=
	generic :: get_nlo_type_component => get_nlo_type_component_all
	procedure :: get_nlo_type_component_all => process_get_nlo_type_component_all
	<<Process: sub interfaces>>=
	pure module function process_get_nlo_type_component_all &
	(process) result (val)
	integer, dimension(:), allocatable :: val
	class(process_t), intent(in) :: process
	end function process_get_nlo_type_component_all
	<<Process: procedures>>=
	pure module function process_get_nlo_type_component_all (process) result (val)
	integer, dimension(:), allocatable :: val
	class(process_t), intent(in) :: process
	allocate (val (size (process%component)))
	val = process%component%get_nlo_type ()
	end function process_get_nlo_type_component_all

	@ %def process_get_nlo_type_component_all
	@
	<<Process: process: TBP>>=
	procedure :: is_nlo_calculation => process_is_nlo_calculation
	<<Process: sub interfaces>>=
	module function process_is_nlo_calculation (process) result (nlo)
	logical :: nlo
	class(process_t), intent(in) :: process
	end function process_is_nlo_calculation
	<<Process: procedures>>=
	module function process_is_nlo_calculation (process) result (nlo)
	logical :: nlo
	class(process_t), intent(in) :: process
	select type (pcm => process%pcm)
	type is (pcm_nlo_t)
	nlo = .true.
	class default
	nlo = .false.
	end select
	end function process_is_nlo_calculation

	@ %def process_is_nlo_calculation
	@
	<<Process: process: TBP>>=
	procedure :: get_negative_sf => process_get_negative_sf
	<<Process: sub interfaces>>=
	module function process_get_negative_sf (process) result (neg_sf)
	logical :: neg_sf
	class(process_t), intent(in) :: process
	end function process_get_negative_sf
	<<Process: procedures>>=
	module function process_get_negative_sf (process) result (neg_sf)
	logical :: neg_sf
	class(process_t), intent(in) :: process
	neg_sf = process%config%process_def%get_negative_sf ()
	end function process_get_negative_sf

	@ %def process_get_negative_sf
	@
	<<Process: process: TBP>>=
	procedure :: is_combined_nlo_integration &
	=> process_is_combined_nlo_integration
	<<Process: sub interfaces>>=
	module function process_is_combined_nlo_integration &
	(process) result (combined)
	logical :: combined
	class(process_t), intent(in) :: process
	end function process_is_combined_nlo_integration
	<<Process: procedures>>=
	module function process_is_combined_nlo_integration &
	(process) result (combined)
	logical :: combined
	class(process_t), intent(in) :: process
	select type (pcm => process%pcm)
	type is (pcm_nlo_t)
	combined = pcm%settings%combined_integration
	class default
	combined = .false.
	end select
	end function process_is_combined_nlo_integration

	@ %def process_is_combined_nlo_integration
	@
	<<Process: process: TBP>>=
	procedure :: component_is_real_finite => process_component_is_real_finite
	<<Process: sub interfaces>>=
	pure module function process_component_is_real_finite &
	(process, i_component) result (val)
	logical :: val
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	end function process_component_is_real_finite
	<<Process: procedures>>=
	pure module function process_component_is_real_finite &
	(process, i_component) result (val)
	logical :: val
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	val = process%component(i_component)%component_type == COMP_REAL_FIN
	end function process_component_is_real_finite

	@ %def process_component_is_real_finite
	@ Return nlo data of a process component
	<<Process: process: TBP>>=
	procedure :: get_component_nlo_type => process_get_component_nlo_type
	<<Process: sub interfaces>>=
	elemental module function process_get_component_nlo_type &
	(process, i_component) result (nlo_type)
	integer :: nlo_type
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	end function process_get_component_nlo_type
	<<Process: procedures>>=
	elemental module function process_get_component_nlo_type &
	(process, i_component) result (nlo_type)
	integer :: nlo_type
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	nlo_type = process%component(i_component)%config%get_nlo_type ()
	end function process_get_component_nlo_type

	@ %def process_get_component_nlo_type
	@ Return a pointer to the core that belongs to a component.
	<<Process: process: TBP>>=
	procedure :: get_component_core_ptr => process_get_component_core_ptr
	<<Process: sub interfaces>>=
	module function process_get_component_core_ptr &
	(process, i_component) result (core)
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_component
	class(prc_core_t), pointer :: core
	end function process_get_component_core_ptr
	<<Process: procedures>>=
	module function process_get_component_core_ptr &
	(process, i_component) result (core)
	class(process_t), intent(in), target :: process
	integer, intent(in) :: i_component
	class(prc_core_t), pointer :: core
	integer :: i_core
	i_core = process%pcm%get_i_core(i_component)
	core => process%core_entry(i_core)%core
	end function process_get_component_core_ptr

	@ %def process_get_component_core_ptr
	@
	<<Process: process: TBP>>=
	procedure :: get_component_associated_born &
	=> process_get_component_associated_born
	<<Process: sub interfaces>>=
	module function process_get_component_associated_born &
	(process, i_component) result (i_born)
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	integer :: i_born
	end function process_get_component_associated_born
	<<Process: procedures>>=
	module function process_get_component_associated_born &
	(process, i_component) result (i_born)
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	integer :: i_born
	i_born = process%component(i_component)%config%get_associated_born ()
	end function process_get_component_associated_born

	@ %def process_get_component_associated_born
	@
	<<Process: process: TBP>>=
	procedure :: get_first_real_component => process_get_first_real_component
	<<Process: sub interfaces>>=
	module function process_get_first_real_component (process) result (i_real)
	integer :: i_real
	class(process_t), intent(in) :: process
	end function process_get_first_real_component
	<<Process: procedures>>=
	module function process_get_first_real_component (process) result (i_real)
	integer :: i_real
	class(process_t), intent(in) :: process
	i_real = process%component(1)%config%get_associated_real ()
	end function process_get_first_real_component

	@ %def process_get_first_real_component
	@
	<<Process: process: TBP>>=
	procedure :: get_first_real_term => process_get_first_real_term
	<<Process: sub interfaces>>=
	module function process_get_first_real_term (process) result (i_real)
	integer :: i_real
	class(process_t), intent(in) :: process
	integer :: i_component, i_term
	end function process_get_first_real_term
	<<Process: procedures>>=
	module function process_get_first_real_term (process) result (i_real)
	integer :: i_real
	class(process_t), intent(in) :: process
	integer :: i_component, i_term
	i_component = process%component(1)%config%get_associated_real ()
	i_real = 0
	do i_term = 1, size (process%term)
	if (process%term(i_term)%i_component == i_component) then
	i_real = i_term
	exit
	end if
	end do
	if (i_real == 0) call msg_fatal ("Did not find associated real term!")
	end function process_get_first_real_term

	@ %def process_get_first_real_term
	@
	<<Process: process: TBP>>=
	procedure :: get_associated_real_fin => process_get_associated_real_fin
	<<Process: sub interfaces>>=
	elemental module function process_get_associated_real_fin &
	(process, i_component) result (i_real)
	integer :: i_real
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	end function process_get_associated_real_fin
	<<Process: procedures>>=
	elemental module function process_get_associated_real_fin &
	(process, i_component) result (i_real)
	integer :: i_real
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_component
	i_real = process%component(i_component)%config%get_associated_real_fin ()
	end function process_get_associated_real_fin

	@ %def process_get_associated_real_fin
	@
	<<Process: process: TBP>>=
	procedure :: select_i_term => process_select_i_term
	<<Process: sub interfaces>>=
	pure module function process_select_i_term (process, i_mci) result (i_term)
	integer :: i_term
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	end function process_select_i_term
	<<Process: procedures>>=
	pure module function process_select_i_term (process, i_mci) result (i_term)
	integer :: i_term
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_mci
	integer :: i_component, i_sub
	i_component = process%mci_entry(i_mci)%i_component(1)
	i_term = process%component(i_component)%i_term(1)
	i_sub = process%term(i_term)%i_sub
	if (i_sub > 0) &
	i_term = process%term(i_sub)%i_term_global
	end function process_select_i_term

	@ %def process_select_i_term
	@ Would be better to do this at the level of the writer of the core but
	one has to bring NLO information there.
	<<Process: process: TBP>>=
	procedure :: prepare_any_external_code &
	=> process_prepare_any_external_code
	<<Process: sub interfaces>>=
	module subroutine process_prepare_any_external_code (process)
	class(process_t), intent(inout), target :: process
	end subroutine process_prepare_any_external_code
	<<Process: procedures>>=
	module subroutine process_prepare_any_external_code (process)
	class(process_t), intent(inout), target :: process
	integer :: i
	if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
	"process_prepare_external_code")
	associate (pcm => process%pcm)
	do i = 1, pcm%n_cores
	call pcm%prepare_any_external_code ( &
	process%core_entry(i), i, &
	process%get_library_name (), &
	process%config%model, &
	process%env%get_var_list_ptr ())
	end do
	end associate
	end subroutine process_prepare_any_external_code

	@ %def process_prepare_any_external_code
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process config}
	<<[[process_config.f90]]>>=
	<<File header>>

	module process_config

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use sf_base
	use sf_mappings
	use mappings, only: mapping_defaults_t
	use phs_forests, only: phs_parameters_t
	use sm_qcd
	use integration_results
	use flavors
	use interactions
	use model_data
	use models
	use process_libraries
	use process_constants
	use prc_core
	use beams
	use mci_base
	use beam_structures
	use dispatch_beams, only: dispatch_qcd
	use phs_base
	use expr_base
	use variables

	<<Standard module head>>

	<<Process config: public>>

	<<Process config: parameters>>

	<<Process config: types>>

	interface
	<<Process config: sub interfaces>>
	end interface

	contains

	<<Process config: main procedures>>

	end module process_config
	@ %def process_config
	@
	<<[[process_config_sub.f90]]>>=
	<<File header>>

	submodule (process_config) process_config_s

	use format_utils, only: write_separator
	use io_units
	use diagnostics
	use md5
	use physics_defs
	use helicities
	use colors
	use quantum_numbers
	use state_matrices
	use prc_external
	use prc_openloops, only: prc_openloops_t
	use prc_threshold, only: prc_threshold_t
	use blha_olp_interfaces, only: prc_blha_t

	implicit none

	contains

	<<Process config: procedures>>

	end submodule process_config_s

	@ %def process_config_s
	@ Identifiers for the NLO setup.
	<<Process config: parameters>>=
	integer, parameter, public :: COMP_DEFAULT = 0
	integer, parameter, public :: COMP_REAL_FIN = 1
	integer, parameter, public :: COMP_MASTER = 2
	integer, parameter, public :: COMP_VIRT = 3
	integer, parameter, public :: COMP_REAL = 4
	integer, parameter, public :: COMP_REAL_SING = 5
	integer, parameter, public :: COMP_MISMATCH = 6
	integer, parameter, public :: COMP_PDF = 7
	integer, parameter, public :: COMP_SUB = 8
	integer, parameter, public :: COMP_RESUM = 9

	@
	\subsection{Output selection flags}
	We declare a number of identifiers for write methods, so they only
	displays selected parts. The identifiers can be supplied to the [[vlist]]
	array argument of the standard F2008 derived-type writer call.
	<<Process config: parameters>>=
	integer, parameter, public :: F_PACIFY = 1
	integer, parameter, public :: F_SHOW_VAR_LIST = 11
	integer, parameter, public :: F_SHOW_EXPRESSIONS = 12
	integer, parameter, public :: F_SHOW_LIB = 13
	integer, parameter, public :: F_SHOW_MODEL = 14
	integer, parameter, public :: F_SHOW_QCD = 15
	integer, parameter, public :: F_SHOW_OS_DATA = 16
	integer, parameter, public :: F_SHOW_RNG = 17
	integer, parameter, public :: F_SHOW_BEAMS = 18
	@ %def SHOW_VAR_LIST
	@ %def SHOW_EXPRESSIONS
	@
	This is a simple function that returns true if a flag value is present in
	[[v_list]], but not its negative. If neither is present, it returns
	[[default]].
	<<Process config: public>>=
	public :: flagged
	<<Process config: sub interfaces>>=
	module function flagged (v_list, id, def) result (flag)
	logical :: flag
	integer, dimension(:), intent(in) :: v_list
	integer, intent(in) :: id
	logical, intent(in), optional :: def
	end function flagged
	<<Process config: procedures>>=
	module function flagged (v_list, id, def) result (flag)
	logical :: flag
	integer, dimension(:), intent(in) :: v_list
	integer, intent(in) :: id
	logical, intent(in), optional :: def
	logical :: default_result
	default_result = .false.; if (present (def)) default_result = def
	if (default_result) then
	flag = all (v_list /= -id)
	else
	flag = all (v_list /= -id) .and. any (v_list == id)
	end if
	end function flagged

	@ %def flagged
	@
	Related: if flag is set (unset), append [[value]] (its negative) to the
	[[v_list]], respectively. [[v_list]] must be allocated.
	<<Process config: public>>=
	public :: set_flag
	<<Process config: sub interfaces>>=
	module subroutine set_flag (v_list, value, flag)
	integer, dimension(:), intent(inout), allocatable :: v_list
	integer, intent(in) :: value
	logical, intent(in), optional :: flag
	end subroutine set_flag
	<<Process config: procedures>>=
	module subroutine set_flag (v_list, value, flag)
	integer, dimension(:), intent(inout), allocatable :: v_list
	integer, intent(in) :: value
	logical, intent(in), optional :: flag
	if (present (flag)) then
	if (flag) then
	v_list = [v_list, value]
	else
	v_list = [v_list, -value]
	end if
	end if
	end subroutine set_flag

	@ %def set_flag
	@
	\subsection{Generic configuration data}
	This information concerns physical and technical properties of the
	process. It is fixed upon initialization, using data from the
	process specification and the variable list.

	The number [[n_in]] is the number of incoming beam particles,
	simultaneously the number of incoming partons, 1 for a decay and 2 for
	a scattering process. (The number of outgoing partons may depend on
	the process component.)

	The number [[n_components]] is the number of components that constitute
	the current process.

	The number [[n_terms]] is the number of distinct contributions to the
	scattering matrix that constitute the current process. Each component
	may generate several terms.

	The number [[n_mci]] is the number of independent MC
	integration configurations that this process uses. Distinct process
	components that share a MCI configuration may be combined pointwise.
	(Nevertheless, a given MC variable set may correspond to several
	``nearby'' kinematical configurations.) This is also the number of
	distinct sampling-function results that this process can generate.
	Process components that use distinct variable sets are added only once
	after an integration pass has completed.

	The [[model]] pointer identifies the physics model and its
	parameters. This is a pointer to an external object.

	Various [[parse_node_t]] objects are taken from the SINDARIN input.
	They encode expressions for evaluating cuts and scales. The
	workspaces for evaluating those expressions are set up in the
	[[effective_state]] subobjects. Note that these are really pointers,
	so the actual nodes are not stored inside the process object.

	The [[md5sum]] is taken and used to verify the process configuration
	when re-reading data from file.
	<<Process config: public>>=
	public :: process_config_data_t
	<<Process config: types>>=
	type :: process_config_data_t
	class(process_def_t), pointer :: process_def => null ()
	integer :: n_in = 0
	integer :: n_components = 0
	integer :: n_terms = 0
	integer :: n_mci = 0
	type(string_t) :: model_name
	class(model_data_t), pointer :: model => null ()
	type(qcd_t) :: qcd
	class(expr_factory_t), allocatable :: ef_cuts
	class(expr_factory_t), allocatable :: ef_scale
	class(expr_factory_t), allocatable :: ef_fac_scale
	class(expr_factory_t), allocatable :: ef_ren_scale
	class(expr_factory_t), allocatable :: ef_weight
	character(32) :: md5sum = ""
	contains
	<<Process config: process config data: TBP>>
	end type process_config_data_t

	@ %def process_config_data_t
	@ Here, we may compress the expressions for cuts etc.
	<<Process config: process config data: TBP>>=
	procedure :: write => process_config_data_write
	<<Process config: sub interfaces>>=
	module subroutine process_config_data_write &
	(config, u, counters, model, expressions)
	class(process_config_data_t), intent(in) :: config
	integer, intent(in) :: u
	logical, intent(in) :: counters
	logical, intent(in) :: model
	logical, intent(in) :: expressions
	end subroutine process_config_data_write
	<<Process config: procedures>>=
	module subroutine process_config_data_write &
	(config, u, counters, model, expressions)
	class(process_config_data_t), intent(in) :: config
	integer, intent(in) :: u
	logical, intent(in) :: counters
	logical, intent(in) :: model
	logical, intent(in) :: expressions
	write (u, "(1x,A)") "Configuration data:"
	if (counters) then
	write (u, "(3x,A,I0)") "Number of incoming particles = ", &
	config%n_in
	write (u, "(3x,A,I0)") "Number of process components = ", &
	config%n_components
	write (u, "(3x,A,I0)") "Number of process terms = ", &
	config%n_terms
	write (u, "(3x,A,I0)") "Number of MCI configurations = ", &
	config%n_mci
	end if
	if (associated (config%model)) then
	write (u, "(3x,A,A)") "Model = ", char (config%model_name)
	if (model) then
	call write_separator (u)
	call config%model%write (u)
	call write_separator (u)
	end if
	else
	write (u, "(3x,A,A,A)") "Model = ", char (config%model_name), &
	" [not associated]"
	end if
	call config%qcd%write (u, show_md5sum = .false.)
	call write_separator (u)
	if (expressions) then
	if (allocated (config%ef_cuts)) then
	call write_separator (u)
	write (u, "(3x,A)") "Cut expression:"
	call config%ef_cuts%write (u)
	end if
	if (allocated (config%ef_scale)) then
	call write_separator (u)
	write (u, "(3x,A)") "Scale expression:"
	call config%ef_scale%write (u)
	end if
	if (allocated (config%ef_fac_scale)) then
	call write_separator (u)
	write (u, "(3x,A)") "Factorization scale expression:"
	call config%ef_fac_scale%write (u)
	end if
	if (allocated (config%ef_ren_scale)) then
	call write_separator (u)
	write (u, "(3x,A)") "Renormalization scale expression:"
	call config%ef_ren_scale%write (u)
	end if
	if (allocated (config%ef_weight)) then
	call write_separator (u)
	write (u, "(3x,A)") "Weight expression:"
	call config%ef_weight%write (u)
	end if
	else
	call write_separator (u)
	write (u, "(3x,A)") "Expressions (cut, scales, weight): [not shown]"
	end if
	if (config%md5sum /= "") then
	call write_separator (u)
	write (u, "(3x,A,A,A)") "MD5 sum (config) = '", config%md5sum, "'"
	end if
	end subroutine process_config_data_write

	@ %def process_config_data_write
	@ Initialize. We use information from the process metadata and from
	the process library, given the process ID. We also store the
	currently active OS data set.

	The model pointer references the model data within the [[env]] record. That
	should be an instance of the global model.

	We initialize the QCD object, unless the environment information is unavailable
	(unit tests).

	The RNG factory object is imported by moving the allocation.
	Gfortran 7/8/9 bug: has to remain in the main module:
	<<Process config: process config data: TBP>>=
	procedure :: init => process_config_data_init
	<<Process config: main procedures>>=
	subroutine process_config_data_init (config, meta, env)
	class(process_config_data_t), intent(out) :: config
	type(process_metadata_t), intent(in) :: meta
	type(process_environment_t), intent(in) :: env
	config%process_def => env%lib%get_process_def_ptr (meta%id)
	config%n_in = config%process_def%get_n_in ()
	config%n_components = size (meta%component_id)
	config%model => env%get_model_ptr ()
	config%model_name = config%model%get_name ()
	if (env%got_var_list ()) then
	call dispatch_qcd &
	(config%qcd, env%get_var_list_ptr (), env%get_os_data ())
	end if
	end subroutine process_config_data_init

	@ %def process_config_data_init
	@ Return a copy of the QCD data block.
	<<Process config: process config data: TBP>>=
	procedure :: get_qcd => process_config_data_get_qcd
	<<Process config: sub interfaces>>=
	module function process_config_data_get_qcd (config) result (qcd)
	class(process_config_data_t), intent(in) :: config
	type(qcd_t) :: qcd
	end function process_config_data_get_qcd
	<<Process config: procedures>>=
	module function process_config_data_get_qcd (config) result (qcd)
	class(process_config_data_t), intent(in) :: config
	type(qcd_t) :: qcd
	qcd = config%qcd
	end function process_config_data_get_qcd

	@ %def process_config_data_get_qcd
	@ Compute the MD5 sum of the configuration data. This encodes, in
	particular, the model and the expressions for cut, scales, weight,
	etc. It should not contain the IDs and number of components, etc.,
	since the MD5 sum should be useful for integrating individual
	components.

	This is done only once. If the MD5 sum is nonempty, the calculation
	is skipped.
	<<Process config: process config data: TBP>>=
	procedure :: compute_md5sum => process_config_data_compute_md5sum
	<<Process config: sub interfaces>>=
	module subroutine process_config_data_compute_md5sum (config)
	class(process_config_data_t), intent(inout) :: config
	end subroutine process_config_data_compute_md5sum
	<<Process config: procedures>>=
	module subroutine process_config_data_compute_md5sum (config)
	class(process_config_data_t), intent(inout) :: config
	integer :: u
	if (config%md5sum == "") then
	u = free_unit ()
	open (u, status = "scratch", action = "readwrite")
	call config%write (u, counters = .false., &
	model = .true., expressions = .true.)
	rewind (u)
	config%md5sum = md5sum (u)
	close (u)
	end if
	end subroutine process_config_data_compute_md5sum

	@ %def process_config_data_compute_md5sum
	@
	<<Process config: process config data: TBP>>=
	procedure :: get_md5sum => process_config_data_get_md5sum
	<<Process config: sub interfaces>>=
	pure module function process_config_data_get_md5sum (config) result (md5)
	character(32) :: md5
	class(process_config_data_t), intent(in) :: config
	end function process_config_data_get_md5sum
	<<Process config: procedures>>=
	pure module function process_config_data_get_md5sum (config) result (md5)
	character(32) :: md5
	class(process_config_data_t), intent(in) :: config
	md5 = config%md5sum
	end function process_config_data_get_md5sum

	@ %def process_config_data_get_md5sum
	@
	\subsection{Environment}
	This record stores a snapshot of the process environment at the point where
	the process object is created.

	Model and variable list are implemented as pointer, so they always have the
	[[target]] attribute.

	For unit-testing purposes, setting the var list is optional. If not set, the
	pointer is null.
	<<Process config: public>>=
	public :: process_environment_t
	<<Process config: types>>=
	type :: process_environment_t
	private
	type(model_t), pointer :: model => null ()
	type(var_list_t), pointer :: var_list => null ()
	logical :: var_list_is_set = .false.
	type(process_library_t), pointer :: lib => null ()
	type(beam_structure_t) :: beam_structure
	type(os_data_t) :: os_data
	contains
	<<Process config: process environment: TBP>>
	end type process_environment_t

	@ %def process_environment_t
	@ Model and local var list are snapshots and need a finalizer.
	<<Process config: process environment: TBP>>=
	procedure :: final => process_environment_final
	<<Process config: sub interfaces>>=
	module subroutine process_environment_final (env)
	class(process_environment_t), intent(inout) :: env
	end subroutine process_environment_final
	<<Process config: procedures>>=
	module subroutine process_environment_final (env)
	class(process_environment_t), intent(inout) :: env
	if (associated (env%model)) then
	call env%model%final ()
	deallocate (env%model)
	end if
	if (associated (env%var_list)) then
	call env%var_list%final (follow_link=.true.)
	deallocate (env%var_list)
	end if
	end subroutine process_environment_final

	@ %def process_environment_final
	@ Output, DTIO compatible.
	<<Process config: process environment: TBP>>=
	procedure :: write => process_environment_write
	procedure :: write_formatted => process_environment_write_formatted
	! generic :: write (formatted) => write_formatted
	<<Process config: sub interfaces>>=
	module subroutine process_environment_write (env, unit, &
	show_var_list, show_model, show_lib, show_beams, show_os_data)
	class(process_environment_t), intent(in) :: env
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_var_list
	logical, intent(in), optional :: show_model
	logical, intent(in), optional :: show_lib
	logical, intent(in), optional :: show_beams
	logical, intent(in), optional :: show_os_data
	end subroutine process_environment_write
	<<Process config: procedures>>=
	module subroutine process_environment_write (env, unit, &
	show_var_list, show_model, show_lib, show_beams, show_os_data)
	class(process_environment_t), intent(in) :: env
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_var_list
	logical, intent(in), optional :: show_model
	logical, intent(in), optional :: show_lib
	logical, intent(in), optional :: show_beams
	logical, intent(in), optional :: show_os_data
	integer :: u, iostat
	integer, dimension(:), allocatable :: v_list
	character(0) :: iomsg
	u = given_output_unit (unit)
	allocate (v_list (0))
	call set_flag (v_list, F_SHOW_VAR_LIST, show_var_list)
	call set_flag (v_list, F_SHOW_MODEL, show_model)
	call set_flag (v_list, F_SHOW_LIB, show_lib)
	call set_flag (v_list, F_SHOW_BEAMS, show_beams)
	call set_flag (v_list, F_SHOW_OS_DATA, show_os_data)
	call env%write_formatted (u, "LISTDIRECTED", v_list, iostat, iomsg)
	end subroutine process_environment_write

	@ %def process_environment_write
	@ DTIO standard write.
	<<Process config: sub interfaces>>=
	module subroutine process_environment_write_formatted &
	(dtv, unit, iotype, v_list, iostat, iomsg)
	class(process_environment_t), intent(in) :: dtv
	integer, intent(in) :: unit
	character(*), intent(in) :: iotype
	integer, dimension(:), intent(in) :: v_list
	integer, intent(out) :: iostat
	character(*), intent(inout) :: iomsg
	end subroutine process_environment_write_formatted
	<<Process config: procedures>>=
	module subroutine process_environment_write_formatted &
	(dtv, unit, iotype, v_list, iostat, iomsg)
	class(process_environment_t), intent(in) :: dtv
	integer, intent(in) :: unit
	character(*), intent(in) :: iotype
	integer, dimension(:), intent(in) :: v_list
	integer, intent(out) :: iostat
	character(*), intent(inout) :: iomsg
	associate (env => dtv)
	if (flagged (v_list, F_SHOW_VAR_LIST, .true.)) then
	write (unit, "(1x,A)") "Variable list:"
	if (associated (env%var_list)) then
	call write_separator (unit)
	call env%var_list%write (unit)
	else
	write (unit, "(3x,A)") "[not allocated]"
	end if
	call write_separator (unit)
	end if
	if (flagged (v_list, F_SHOW_MODEL, .true.)) then
	write (unit, "(1x,A)") "Model:"
	if (associated (env%model)) then
	call write_separator (unit)
	call env%model%write (unit)
	else
	write (unit, "(3x,A)") "[not allocated]"
	end if
	call write_separator (unit)
	end if
	if (flagged (v_list, F_SHOW_LIB, .true.)) then
	write (unit, "(1x,A)") "Process library:"
	if (associated (env%lib)) then
	call write_separator (unit)
	call env%lib%write (unit)
	else
	write (unit, "(3x,A)") "[not allocated]"
	end if
	end if
	if (flagged (v_list, F_SHOW_BEAMS, .true.)) then
	call write_separator (unit)
	call env%beam_structure%write (unit)
	end if
	if (flagged (v_list, F_SHOW_OS_DATA, .true.)) then
	write (unit, "(1x,A)") "Operating-system data:"
	call write_separator (unit)
	call env%os_data%write (unit)
	end if
	end associate
	iostat = 0
	end subroutine process_environment_write_formatted

	@ %def process_environment_write_formatted
	@ Initialize: Make a snapshot of the provided model. Make a link to the
	current process library.

	Also make a snapshot of the variable list, if provided. If none is
	provided, there is an empty variable list nevertheless, so a pointer
	lookup does not return null.

	If no beam structure is provided, the beam-structure member is empty and will
	yield a number of zero beams when queried.
	<<Process config: process environment: TBP>>=
	procedure :: init => process_environment_init
	<<Process config: sub interfaces>>=
	module subroutine process_environment_init &
	(env, model, lib, os_data, var_list, beam_structure)
	class(process_environment_t), intent(out) :: env
	type(model_t), intent(in), target :: model
	type(process_library_t), intent(in), target :: lib
	type(os_data_t), intent(in) :: os_data
	type(var_list_t), intent(in), target, optional :: var_list
	type(beam_structure_t), intent(in), optional :: beam_structure
	end subroutine process_environment_init
	<<Process config: procedures>>=
	module subroutine process_environment_init &
	(env, model, lib, os_data, var_list, beam_structure)
	class(process_environment_t), intent(out) :: env
	type(model_t), intent(in), target :: model
	type(process_library_t), intent(in), target :: lib
	type(os_data_t), intent(in) :: os_data
	type(var_list_t), intent(in), target, optional :: var_list
	type(beam_structure_t), intent(in), optional :: beam_structure
	allocate (env%model)
	call env%model%init_instance (model)
	env%lib => lib
	env%os_data = os_data
	allocate (env%var_list)
	if (present (var_list)) then
	call env%var_list%init_snapshot (var_list, follow_link=.true.)
	env%var_list_is_set = .true.
	end if
	if (present (beam_structure)) then
	env%beam_structure = beam_structure
	end if
	end subroutine process_environment_init

	@ %def process_environment_init
	@ Indicate whether a variable list has been provided upon initialization.
	<<Process config: process environment: TBP>>=
	procedure :: got_var_list => process_environment_got_var_list
	<<Process config: sub interfaces>>=
	module function process_environment_got_var_list (env) result (flag)
	class(process_environment_t), intent(in) :: env
	logical :: flag
	end function process_environment_got_var_list
	<<Process config: procedures>>=
	module function process_environment_got_var_list (env) result (flag)
	class(process_environment_t), intent(in) :: env
	logical :: flag
	flag = env%var_list_is_set
	end function process_environment_got_var_list

	@ %def process_environment_got_var_list
	@ Return a pointer to the variable list.
	<<Process config: process environment: TBP>>=
	procedure :: get_var_list_ptr => process_environment_get_var_list_ptr
	<<Process config: sub interfaces>>=
	module function process_environment_get_var_list_ptr (env) result (var_list)
	class(process_environment_t), intent(in) :: env
	type(var_list_t), pointer :: var_list
	end function process_environment_get_var_list_ptr
	<<Process config: procedures>>=
	module function process_environment_get_var_list_ptr (env) result (var_list)
	class(process_environment_t), intent(in) :: env
	type(var_list_t), pointer :: var_list
	var_list => env%var_list
	end function process_environment_get_var_list_ptr

	@ %def process_environment_get_var_list_ptr
	@ Return a pointer to the model, if it exists.
	<<Process config: process environment: TBP>>=
	procedure :: get_model_ptr => process_environment_get_model_ptr
	<<Process config: sub interfaces>>=
	module function process_environment_get_model_ptr (env) result (model)
	class(process_environment_t), intent(in) :: env
	type(model_t), pointer :: model
	end function process_environment_get_model_ptr
	<<Process config: procedures>>=
	module function process_environment_get_model_ptr (env) result (model)
	class(process_environment_t), intent(in) :: env
	type(model_t), pointer :: model
	model => env%model
	end function process_environment_get_model_ptr

	@ %def process_environment_get_model_ptr
	@ Return the process library pointer.
	<<Process config: process environment: TBP>>=
	procedure :: get_lib_ptr => process_environment_get_lib_ptr
	<<Process config: sub interfaces>>=
	module function process_environment_get_lib_ptr (env) result (lib)
	class(process_environment_t), intent(inout) :: env
	type(process_library_t), pointer :: lib
	end function process_environment_get_lib_ptr
	<<Process config: procedures>>=
	module function process_environment_get_lib_ptr (env) result (lib)
	class(process_environment_t), intent(inout) :: env
	type(process_library_t), pointer :: lib
	lib => env%lib
	end function process_environment_get_lib_ptr

	@ %def process_environment_get_lib_ptr
	@ Clear the process library pointer, in case the library is deleted.
	<<Process config: process environment: TBP>>=
	procedure :: reset_lib_ptr => process_environment_reset_lib_ptr
	<<Process config: sub interfaces>>=
	module subroutine process_environment_reset_lib_ptr (env)
	class(process_environment_t), intent(inout) :: env
	end subroutine process_environment_reset_lib_ptr
	<<Process config: procedures>>=
	module subroutine process_environment_reset_lib_ptr (env)
	class(process_environment_t), intent(inout) :: env
	env%lib => null ()
	end subroutine process_environment_reset_lib_ptr

	@ %def process_environment_reset_lib_ptr
	@ Check whether the process library has changed, in case the library is
	recompiled, etc.
	<<Process config: process environment: TBP>>=
	procedure :: check_lib_sanity => process_environment_check_lib_sanity
	<<Process config: sub interfaces>>=
	module subroutine process_environment_check_lib_sanity (env, meta)
	class(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	end subroutine process_environment_check_lib_sanity
	<<Process config: procedures>>=
	module subroutine process_environment_check_lib_sanity (env, meta)
	class(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	if (associated (env%lib)) then
	if (env%lib%get_update_counter () /= meta%lib_update_counter) then
	call msg_fatal ("Process '" // char (meta%id) &
	// "': library has been recompiled after integration")
	end if
	end if
	end subroutine process_environment_check_lib_sanity

	@ %def process_environment_check_lib_sanity
	@ Fill the [[data]] block using the appropriate process-library access entry.
	<<Process config: process environment: TBP>>=
	procedure :: fill_process_constants => &
	process_environment_fill_process_constants
	<<Process config: sub interfaces>>=
	module subroutine process_environment_fill_process_constants &
	(env, id, i_component, data)
	class(process_environment_t), intent(in) :: env
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	type(process_constants_t), intent(out) :: data
	end subroutine process_environment_fill_process_constants
	<<Process config: procedures>>=
	module subroutine process_environment_fill_process_constants &
	(env, id, i_component, data)
	class(process_environment_t), intent(in) :: env
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	type(process_constants_t), intent(out) :: data
	call env%lib%fill_constants (id, i_component, data)
	end subroutine process_environment_fill_process_constants

	@ %def process_environment_fill_process_constants
	@ Return the entire beam structure.
	<<Process config: process environment: TBP>>=
	procedure :: get_beam_structure => process_environment_get_beam_structure
	<<Process config: sub interfaces>>=
	module function process_environment_get_beam_structure &
	(env) result (beam_structure)
	class(process_environment_t), intent(in) :: env
	type(beam_structure_t) :: beam_structure
	end function process_environment_get_beam_structure
	<<Process config: procedures>>=
	module function process_environment_get_beam_structure &
	(env) result (beam_structure)
	class(process_environment_t), intent(in) :: env
	type(beam_structure_t) :: beam_structure
	beam_structure = env%beam_structure
	end function process_environment_get_beam_structure

	@ %def process_environment_get_beam_structure
	@ Check the beam structure for PDFs.
	<<Process config: process environment: TBP>>=
	procedure :: has_pdfs => process_environment_has_pdfs
	<<Process config: sub interfaces>>=
	module function process_environment_has_pdfs (env) result (flag)
	class(process_environment_t), intent(in) :: env
	logical :: flag
	end function process_environment_has_pdfs
	<<Process config: procedures>>=
	module function process_environment_has_pdfs (env) result (flag)
	class(process_environment_t), intent(in) :: env
	logical :: flag
	flag = env%beam_structure%has_pdf ()
	end function process_environment_has_pdfs

	@ %def process_environment_has_pdfs
	@ Check the beam structure for polarized beams.
	<<Process config: process environment: TBP>>=
	procedure :: has_polarized_beams => process_environment_has_polarized_beams
	<<Process config: sub interfaces>>=
	module function process_environment_has_polarized_beams (env) result (flag)
	class(process_environment_t), intent(in) :: env
	logical :: flag
	end function process_environment_has_polarized_beams
	<<Process config: procedures>>=
	module function process_environment_has_polarized_beams (env) result (flag)
	class(process_environment_t), intent(in) :: env
	logical :: flag
	flag = env%beam_structure%has_polarized_beams ()
	end function process_environment_has_polarized_beams

	@ %def process_environment_has_polarized_beams
	@ Return a copy of the OS data block.
	<<Process config: process environment: TBP>>=
	procedure :: get_os_data => process_environment_get_os_data
	<<Process config: sub interfaces>>=
	module function process_environment_get_os_data (env) result (os_data)
	class(process_environment_t), intent(in) :: env
	type(os_data_t) :: os_data
	end function process_environment_get_os_data
	<<Process config: procedures>>=
	module function process_environment_get_os_data (env) result (os_data)
	class(process_environment_t), intent(in) :: env
	type(os_data_t) :: os_data
	os_data = env%os_data
	end function process_environment_get_os_data

	@ %def process_environment_get_os_data
	@
	\subsection{Metadata}
	This information describes the process. It is fixed upon initialization.

	The [[id]] string is the name of the process object, as given by the
	user. The matrix element generator will use this string for naming
	Fortran procedures and types, so it should qualify as a Fortran name.

	The [[num_id]] is meaningful if nonzero. It is used for communication
	with external programs or file standards which do not support string IDs.

	The [[run_id]] string distinguishes among several runs for the same
	process. It identifies process instances with respect to adapted
	integration grids and similar run-specific data. The run ID is kept
	when copying processes for creating instances, however, so it does not
	distinguish event samples.

	The [[lib_name]] identifies the process library where the process
	definition and the process driver are located.

	The [[lib_index]] is the index of entry in the process library that
	corresponds to the current process.

	The [[component_id]] array identifies the individual process components.

	The [[component_description]] is an array of human-readable strings
	that characterize the process components, for instance [[a, b => c, d]].

	The [[active]] mask array marks those components which are active. The others
	are skipped.
	<<Process config: public>>=
	public :: process_metadata_t
	<<Process config: types>>=
	type :: process_metadata_t
	integer :: type = PRC_UNKNOWN
	type(string_t) :: id
	integer :: num_id = 0
	type(string_t) :: run_id
	type(string_t), allocatable :: lib_name
	integer :: lib_update_counter = 0
	integer :: lib_index = 0
	integer :: n_components = 0
	type(string_t), dimension(:), allocatable :: component_id
	type(string_t), dimension(:), allocatable :: component_description
	logical, dimension(:), allocatable :: active
	contains
	<<Process config: process metadata: TBP>>
	end type process_metadata_t

	@ %def process_metadata_t
	@ Output: ID and run ID.
	We write the variable list only upon request.
	<<Process config: process metadata: TBP>>=
	procedure :: write => process_metadata_write
	<<Process config: sub interfaces>>=
	module subroutine process_metadata_write (meta, u, screen)
	class(process_metadata_t), intent(in) :: meta
	integer, intent(in) :: u
	logical, intent(in) :: screen
	end subroutine process_metadata_write
	<<Process config: procedures>>=
	module subroutine process_metadata_write (meta, u, screen)
	class(process_metadata_t), intent(in) :: meta
	integer, intent(in) :: u
	logical, intent(in) :: screen
	integer :: i
	select case (meta%type)
	case (PRC_UNKNOWN)
	if (screen) then
	write (msg_buffer, "(A)") "Process [undefined]"
	else
	write (u, "(1x,A)") "Process [undefined]"
	end if
	return
	case (PRC_DECAY)
	if (screen) then
	write (msg_buffer, "(A,1x,A,A,A)") "Process [decay]:", &
	"'", char (meta%id), "'"
	else
	write (u, "(1x,A)", advance="no") "Process [decay]:"
	end if
	case (PRC_SCATTERING)
	if (screen) then
	write (msg_buffer, "(A,1x,A,A,A)") "Process [scattering]:", &
	"'", char (meta%id), "'"
	else
	write (u, "(1x,A)", advance="no") "Process [scattering]:"
	end if
	case default
	call msg_bug ("process_write: undefined process type")
	end select
	if (screen) then
	call msg_message ()
	else
	write (u, "(1x,A,A,A)") "'", char (meta%id), "'"
	end if
	if (meta%num_id /= 0) then
	if (screen) then
	write (msg_buffer, "(2x,A,I0)") "ID (num) = ", meta%num_id
	call msg_message ()
	else
	write (u, "(3x,A,I0)") "ID (num) = ", meta%num_id
	end if
	end if
	if (screen) then
	if (meta%run_id /= "") then
	write (msg_buffer, "(2x,A,A,A)") "Run ID = '", &
	char (meta%run_id), "'"
	call msg_message ()
	end if
	else
	write (u, "(3x,A,A,A)") "Run ID = '", char (meta%run_id), "'"
	end if
	if (allocated (meta%lib_name)) then
	if (screen) then
	write (msg_buffer, "(2x,A,A,A)") "Library name = '", &
	char (meta%lib_name), "'"
	call msg_message ()
	else
	write (u, "(3x,A,A,A)") "Library name = '", &
	char (meta%lib_name), "'"
	end if
	else
	if (screen) then
	write (msg_buffer, "(2x,A)") "Library name = [not associated]"
	call msg_message ()
	else
	write (u, "(3x,A)") "Library name = [not associated]"
	end if
	end if
	if (screen) then
	write (msg_buffer, "(2x,A,I0)") "Process index = ", meta%lib_index
	call msg_message ()
	else
	write (u, "(3x,A,I0)") "Process index = ", meta%lib_index
	end if
	if (allocated (meta%component_id)) then
	if (screen) then
	if (any (meta%active)) then
	write (msg_buffer, "(2x,A)") "Process components:"
	else
	write (msg_buffer, "(2x,A)") "Process components: [none]"
	end if
	call msg_message ()
	else
	write (u, "(3x,A)") "Process components:"
	end if
	do i = 1, size (meta%component_id)
	if (.not. meta%active(i)) cycle
	if (screen) then
	write (msg_buffer, "(4x,I0,9A)") i, ": '", &
	char (meta%component_id (i)), "': ", &
	char (meta%component_description (i))
	call msg_message ()
	else
	write (u, "(5x,I0,9A)") i, ": '", &
	char (meta%component_id (i)), "': ", &
	char (meta%component_description (i))
	end if
	end do
	end if
	if (screen) then
	write (msg_buffer, "(A)") repeat ("-", 72)
	call msg_message ()
	else
	call write_separator (u)
	end if
	end subroutine process_metadata_write

	@ %def process_metadata_write
	@ Short output: list components.
	<<Process config: process metadata: TBP>>=
	procedure :: show => process_metadata_show
	<<Process config: sub interfaces>>=
	module subroutine process_metadata_show (meta, u, model_name)
	class(process_metadata_t), intent(in) :: meta
	integer, intent(in) :: u
	type(string_t), intent(in) :: model_name
	end subroutine process_metadata_show
	<<Process config: procedures>>=
	module subroutine process_metadata_show (meta, u, model_name)
	class(process_metadata_t), intent(in) :: meta
	integer, intent(in) :: u
	type(string_t), intent(in) :: model_name
	integer :: i
	select case (meta%type)
	case (PRC_UNKNOWN)
	write (u, "(A)") "Process: [undefined]"
	return
	case default
	write (u, "(A)", advance="no") "Process:"
	end select
	write (u, "(1x,A)", advance="no") char (meta%id)
	select case (meta%num_id)
	case (0)
	case default
	write (u, "(1x,'(',I0,')')", advance="no") meta%num_id
	end select
	select case (char (model_name))
	case ("")
	case default
	write (u, "(1x,'[',A,']')", advance="no") char (model_name)
	end select
	write (u, *)
	if (allocated (meta%component_id)) then
	do i = 1, size (meta%component_id)
	if (meta%active(i)) then
	write (u, "(2x,I0,':',1x,A)") i, &
	char (meta%component_description (i))
	end if
	end do
	end if
	end subroutine process_metadata_show

	@ %def process_metadata_show
	@ Initialize. Find process ID and run ID.

	Also find the process ID in the process library and retrieve some metadata from
	there.
	<<Process config: process metadata: TBP>>=
	procedure :: init => process_metadata_init
	<<Process config: sub interfaces>>=
	module subroutine process_metadata_init (meta, id, lib, var_list)
	class(process_metadata_t), intent(out) :: meta
	type(string_t), intent(in) :: id
	type(process_library_t), intent(in), target :: lib
	type(var_list_t), intent(in) :: var_list
	end subroutine process_metadata_init
	<<Process config: procedures>>=
	module subroutine process_metadata_init (meta, id, lib, var_list)
	class(process_metadata_t), intent(out) :: meta
	type(string_t), intent(in) :: id
	type(process_library_t), intent(in), target :: lib
	type(var_list_t), intent(in) :: var_list
	select case (lib%get_n_in (id))
	case (1); meta%type = PRC_DECAY
	case (2); meta%type = PRC_SCATTERING
	case default
	call msg_bug ("Process '" // char (id) // "': impossible n_in")
	end select
	meta%id = id
	meta%run_id = var_list%get_sval (var_str ("$run_id"))
	allocate (meta%lib_name)
	meta%lib_name = lib%get_name ()
	meta%lib_update_counter = lib%get_update_counter ()
	if (lib%contains (id)) then
	meta%lib_index = lib%get_entry_index (id)
	meta%num_id = lib%get_num_id (id)
	call lib%get_component_list (id, meta%component_id)
	meta%n_components = size (meta%component_id)
	call lib%get_component_description_list &
	(id, meta%component_description)
	allocate (meta%active (meta%n_components), source = .true.)
	else
	call msg_fatal ("Process library does not contain process '" &
	// char (id) // "'")
	end if
	if (.not. lib%is_active ()) then
	call msg_bug ("Process init: inactive library not handled yet")
	end if
	end subroutine process_metadata_init

	@ %def process_metadata_init
	@ Mark a component as inactive.
	<<Process config: process metadata: TBP>>=
	procedure :: deactivate_component => process_metadata_deactivate_component
	<<Process config: sub interfaces>>=
	module subroutine process_metadata_deactivate_component (meta, i)
	class(process_metadata_t), intent(inout) :: meta
	integer, intent(in) :: i
	end subroutine process_metadata_deactivate_component
	<<Process config: procedures>>=
	module subroutine process_metadata_deactivate_component (meta, i)
	class(process_metadata_t), intent(inout) :: meta
	integer, intent(in) :: i
	call msg_message ("Process component '" &
	// char (meta%component_id(i)) // "': matrix element vanishes")
	meta%active(i) = .false.
	end subroutine process_metadata_deactivate_component

	@ %def process_metadata_deactivate_component
	@
	\subsection{Phase-space configuration}
	A process can have a number of independent phase-space configuration entries,
	depending on the process definition and evaluation algorithm. Each entry
	holds various configuration-parameter data and the actual [[phs_config_t]]
	record, which can vary in concrete type.
	<<Process config: public>>=
	public :: process_phs_config_t
	<<Process config: types>>=
	type :: process_phs_config_t
	type(phs_parameters_t) :: phs_par
	type(mapping_defaults_t) :: mapping_defs
	class(phs_config_t), allocatable :: phs_config
	contains
	<<Process config: process phs config: TBP>>
	end type process_phs_config_t

	@ %def process_phs_config_t
	@ Output, DTIO compatible.
	<<Process config: process phs config: TBP>>=
	procedure :: write => process_phs_config_write
	procedure :: write_formatted => process_phs_config_write_formatted
	! generic :: write (formatted) => write_formatted
	<<Process config: sub interfaces>>=
	module subroutine process_phs_config_write (phs_config, unit)
	class(process_phs_config_t), intent(in) :: phs_config
	integer, intent(in), optional :: unit
	end subroutine process_phs_config_write
	<<Process config: procedures>>=
	module subroutine process_phs_config_write (phs_config, unit)
	class(process_phs_config_t), intent(in) :: phs_config
	integer, intent(in), optional :: unit
	integer :: u, iostat
	integer, dimension(:), allocatable :: v_list
	character(0) :: iomsg
	u = given_output_unit (unit)
	allocate (v_list (0))
	call phs_config%write_formatted (u, "LISTDIRECTED", v_list, iostat, iomsg)
	end subroutine process_phs_config_write

	@ %def process_phs_config_write
	@ DTIO standard write.
	<<Process config: sub interfaces>>=
	module subroutine process_phs_config_write_formatted &
	(dtv, unit, iotype, v_list, iostat, iomsg)
	class(process_phs_config_t), intent(in) :: dtv
	integer, intent(in) :: unit
	character(*), intent(in) :: iotype
	integer, dimension(:), intent(in) :: v_list
	integer, intent(out) :: iostat
	character(*), intent(inout) :: iomsg
	end subroutine process_phs_config_write_formatted
	<<Process config: procedures>>=
	module subroutine process_phs_config_write_formatted &
	(dtv, unit, iotype, v_list, iostat, iomsg)
	class(process_phs_config_t), intent(in) :: dtv
	integer, intent(in) :: unit
	character(*), intent(in) :: iotype
	integer, dimension(:), intent(in) :: v_list
	integer, intent(out) :: iostat
	character(*), intent(inout) :: iomsg
	associate (phs_config => dtv)
	write (unit, "(1x, A)") "Phase-space configuration entry:"
	call phs_config%phs_par%write (unit)
	call phs_config%mapping_defs%write (unit)
	end associate
	iostat = 0
	end subroutine process_phs_config_write_formatted

	@ %def process_phs_config_write_formatted
	@
	\subsection{Beam configuration}
	The object [[data]] holds all details about the initial beam
	configuration. The allocatable array [[sf]] holds the structure-function
	configuration blocks. There are [[n_strfun]] entries in the
	structure-function chain (not counting the initial beam object). We
	maintain [[n_channel]] independent parameterizations of this chain.
	If this is greater than zero, we need a multi-channel sampling
	algorithm, where for each point one channel is selected to generate
	kinematics.

	The number of parameters that are required for generating a
	structure-function chain is [[n_sfpar]].

	The flag [[azimuthal_dependence]] tells whether the process setup is
	symmetric about the beam axis in the c.m.\ system. This implies that
	there is no transversal beam polarization. The flag [[lab_is_cm]] is
	obvious.
	<<Process config: public>>=
	public :: process_beam_config_t
	<<Process config: types>>=
	type :: process_beam_config_t
	type(beam_data_t) :: data
	integer :: n_strfun = 0
	integer :: n_channel = 1
	integer :: n_sfpar = 0
	type(sf_config_t), dimension(:), allocatable :: sf
	type(sf_channel_t), dimension(:), allocatable :: sf_channel
	logical :: azimuthal_dependence = .false.
	logical :: lab_is_cm = .true.
	character(32) :: md5sum = ""
	logical :: sf_trace = .false.
	type(string_t) :: sf_trace_file
	contains
	<<Process config: process beam config: TBP>>
	end type process_beam_config_t

	@ %def process_beam_config_t
	@ Here we write beam data only if they are actually used.

	The [[verbose]] flag is passed to the beam-data writer.
	<<Process config: process beam config: TBP>>=
	procedure :: write => process_beam_config_write
	<<Process config: sub interfaces>>=
	module subroutine process_beam_config_write (object, unit, verbose)
	class(process_beam_config_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine process_beam_config_write
	<<Process config: procedures>>=
	module subroutine process_beam_config_write (object, unit, verbose)
	class(process_beam_config_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u, i, c
	u = given_output_unit (unit)
	call object%data%write (u, verbose = verbose)
	if (object%data%initialized) then
	write (u, "(3x,A,L1)") "Azimuthal dependence = ", &
	object%azimuthal_dependence
	write (u, "(3x,A,L1)") "Lab frame is c.m. frame = ", &
	object%lab_is_cm
	if (object%md5sum /= "") then
	write (u, "(3x,A,A,A)") "MD5 sum (beams/strf) = '", &
	object%md5sum, "'"
	end if
	if (allocated (object%sf)) then
	do i = 1, size (object%sf)
	call object%sf(i)%write (u)
	end do
	if (any_sf_channel_has_mapping (object%sf_channel)) then
	write (u, "(1x,A,L1)") "Structure-function mappings per channel:"
	do c = 1, object%n_channel
	write (u, "(3x,I0,':')", advance="no") c
	call object%sf_channel(c)%write (u)
	end do
	end if
	end if
	end if
	end subroutine process_beam_config_write

	@ %def process_beam_config_write
	@ The beam data have a finalizer. We assume that there is none for the
	structure-function data.
	<<Process config: process beam config: TBP>>=
	procedure :: final => process_beam_config_final
	<<Process config: sub interfaces>>=
	module subroutine process_beam_config_final (object)
	class(process_beam_config_t), intent(inout) :: object
	end subroutine process_beam_config_final
	<<Process config: procedures>>=
	module subroutine process_beam_config_final (object)
	class(process_beam_config_t), intent(inout) :: object
	call object%data%final ()
	end subroutine process_beam_config_final

	@ %def process_beam_config_final
	@ Initialize the beam setup with a given beam structure object.
	<<Process config: process beam config: TBP>>=
	procedure :: init_beam_structure => process_beam_config_init_beam_structure
	<<Process config: sub interfaces>>=
	module subroutine process_beam_config_init_beam_structure &
	(beam_config, beam_structure, sqrts, model, decay_rest_frame)
	class(process_beam_config_t), intent(out) :: beam_config
	type(beam_structure_t), intent(in) :: beam_structure
	logical, intent(in), optional :: decay_rest_frame
	real(default), intent(in) :: sqrts
	class(model_data_t), intent(in), target :: model
	end subroutine process_beam_config_init_beam_structure
	<<Process config: procedures>>=
	module subroutine process_beam_config_init_beam_structure &
	(beam_config, beam_structure, sqrts, model, decay_rest_frame)
	class(process_beam_config_t), intent(out) :: beam_config
	type(beam_structure_t), intent(in) :: beam_structure
	logical, intent(in), optional :: decay_rest_frame
	real(default), intent(in) :: sqrts
	class(model_data_t), intent(in), target :: model
	call beam_config%data%init_structure (beam_structure, &
	sqrts, model, decay_rest_frame)
	beam_config%lab_is_cm = beam_config%data%lab_is_cm
	end subroutine process_beam_config_init_beam_structure

	@ %def process_beam_config_init_beam_structure
	@ Initialize the beam setup for a scattering process with specified
	flavor combination, other properties taken from the beam structure
	object (if any).
	<<Process config: process beam config: TBP>>=
	procedure :: init_scattering => process_beam_config_init_scattering
	<<Process config: sub interfaces>>=
	module subroutine process_beam_config_init_scattering &
	(beam_config, flv_in, sqrts, beam_structure)
	class(process_beam_config_t), intent(out) :: beam_config
	type(flavor_t), dimension(2), intent(in) :: flv_in
	real(default), intent(in) :: sqrts
	type(beam_structure_t), intent(in), optional :: beam_structure
	end subroutine process_beam_config_init_scattering
	<<Process config: procedures>>=
	module subroutine process_beam_config_init_scattering &
	(beam_config, flv_in, sqrts, beam_structure)
	class(process_beam_config_t), intent(out) :: beam_config
	type(flavor_t), dimension(2), intent(in) :: flv_in
	real(default), intent(in) :: sqrts
	type(beam_structure_t), intent(in), optional :: beam_structure
	if (present (beam_structure)) then
	if (beam_structure%polarized ()) then
	call beam_config%data%init_sqrts (sqrts, flv_in, &
	beam_structure%get_smatrix (), beam_structure%get_pol_f ())
	else
	call beam_config%data%init_sqrts (sqrts, flv_in)
	end if
	else
	call beam_config%data%init_sqrts (sqrts, flv_in)
	end if
	end subroutine process_beam_config_init_scattering

	@ %def process_beam_config_init_scattering
	@ Initialize the beam setup for a decay process with specified flavor,
	other properties taken from the beam structure object (if present).

	For a cascade decay, we set
	[[rest_frame]] to false, indicating a event-wise varying momentum.
	The beam data itself are initialized for the particle at rest.
	<<Process config: process beam config: TBP>>=
	procedure :: init_decay => process_beam_config_init_decay
	<<Process config: sub interfaces>>=
	module subroutine process_beam_config_init_decay &
	(beam_config, flv_in, rest_frame, beam_structure)
	class(process_beam_config_t), intent(out) :: beam_config
	type(flavor_t), dimension(1), intent(in) :: flv_in
	logical, intent(in), optional :: rest_frame
	type(beam_structure_t), intent(in), optional :: beam_structure
	end subroutine process_beam_config_init_decay
	<<Process config: procedures>>=
	module subroutine process_beam_config_init_decay &
	(beam_config, flv_in, rest_frame, beam_structure)
	class(process_beam_config_t), intent(out) :: beam_config
	type(flavor_t), dimension(1), intent(in) :: flv_in
	logical, intent(in), optional :: rest_frame
	type(beam_structure_t), intent(in), optional :: beam_structure
	if (present (beam_structure)) then
	if (beam_structure%polarized ()) then
	call beam_config%data%init_decay (flv_in, &
	beam_structure%get_smatrix (), beam_structure%get_pol_f (), &
	rest_frame = rest_frame)
	else
	call beam_config%data%init_decay (flv_in, rest_frame = rest_frame)
	end if
	else
	call beam_config%data%init_decay (flv_in, &
	rest_frame = rest_frame)
	end if
	beam_config%lab_is_cm = beam_config%data%lab_is_cm
	end subroutine process_beam_config_init_decay

	@ %def process_beam_config_init_decay
	@ Print an informative message.
	<<Process config: process beam config: TBP>>=
	procedure :: startup_message => process_beam_config_startup_message
	<<Process config: sub interfaces>>=
	module subroutine process_beam_config_startup_message &
	(beam_config, unit, beam_structure)
	class(process_beam_config_t), intent(in) :: beam_config
	integer, intent(in), optional :: unit
	type(beam_structure_t), intent(in), optional :: beam_structure
	end subroutine process_beam_config_startup_message
	<<Process config: procedures>>=
	module subroutine process_beam_config_startup_message &
	(beam_config, unit, beam_structure)
	class(process_beam_config_t), intent(in) :: beam_config
	integer, intent(in), optional :: unit
	type(beam_structure_t), intent(in), optional :: beam_structure
	integer :: u
	u = free_unit ()
	open (u, status="scratch", action="readwrite")
	if (present (beam_structure)) then
	call beam_structure%write (u)
	end if
	call beam_config%data%write (u)
	rewind (u)
	do
	read (u, "(1x,A)", end=1) msg_buffer
	call msg_message ()
	end do
	1 continue
	close (u)
	end subroutine process_beam_config_startup_message

	@ %def process_beam_config_startup_message
	@ Allocate the structure-function array.
	<<Process config: process beam config: TBP>>=
	procedure :: init_sf_chain => process_beam_config_init_sf_chain
	<<Process config: sub interfaces>>=
	module subroutine process_beam_config_init_sf_chain &
	(beam_config, sf_config, sf_trace_file)
	class(process_beam_config_t), intent(inout) :: beam_config
	type(sf_config_t), dimension(:), intent(in) :: sf_config
	type(string_t), intent(in), optional :: sf_trace_file
	end subroutine process_beam_config_init_sf_chain
	<<Process config: procedures>>=
	module subroutine process_beam_config_init_sf_chain &
	(beam_config, sf_config, sf_trace_file)
	class(process_beam_config_t), intent(inout) :: beam_config
	type(sf_config_t), dimension(:), intent(in) :: sf_config
	type(string_t), intent(in), optional :: sf_trace_file
	integer :: i
	beam_config%n_strfun = size (sf_config)
	allocate (beam_config%sf (beam_config%n_strfun))
	do i = 1, beam_config%n_strfun
	associate (sf => sf_config(i))
	call beam_config%sf(i)%init (sf%i, sf%data)
	if (.not. sf%data%is_generator ()) then
	beam_config%n_sfpar = beam_config%n_sfpar + sf%data%get_n_par ()
	end if
	end associate
	end do
	if (present (sf_trace_file)) then
	beam_config%sf_trace = .true.
	beam_config%sf_trace_file = sf_trace_file
	end if
	end subroutine process_beam_config_init_sf_chain

	@ %def process_beam_config_init_sf_chain
	@ Allocate the structure-function mapping channel array, given the
	requested number of channels.
	<<Process config: process beam config: TBP>>=
	procedure :: allocate_sf_channels => process_beam_config_allocate_sf_channels
	<<Process config: sub interfaces>>=
	module subroutine process_beam_config_allocate_sf_channels &
	(beam_config, n_channel)
	class(process_beam_config_t), intent(inout) :: beam_config
	integer, intent(in) :: n_channel
	end subroutine process_beam_config_allocate_sf_channels
	<<Process config: procedures>>=
	module subroutine process_beam_config_allocate_sf_channels &
	(beam_config, n_channel)
	class(process_beam_config_t), intent(inout) :: beam_config
	integer, intent(in) :: n_channel
	beam_config%n_channel = n_channel
	call allocate_sf_channels (beam_config%sf_channel, &
	n_channel = n_channel, &
	n_strfun = beam_config%n_strfun)
	end subroutine process_beam_config_allocate_sf_channels

	@ %def process_beam_config_allocate_sf_channels
	@ Set a structure-function mapping channel for an array of
	structure-function entries, for a single channel. (The default is no mapping.)
	<<Process config: process beam config: TBP>>=
	procedure :: set_sf_channel => process_beam_config_set_sf_channel
	<<Process config: sub interfaces>>=
	module subroutine process_beam_config_set_sf_channel &
	(beam_config, c, sf_channel)
	class(process_beam_config_t), intent(inout) :: beam_config
	integer, intent(in) :: c
	type(sf_channel_t), intent(in) :: sf_channel
	end subroutine process_beam_config_set_sf_channel
	<<Process config: procedures>>=
	module subroutine process_beam_config_set_sf_channel &
	(beam_config, c, sf_channel)
	class(process_beam_config_t), intent(inout) :: beam_config
	integer, intent(in) :: c
	type(sf_channel_t), intent(in) :: sf_channel
	beam_config%sf_channel(c) = sf_channel
	end subroutine process_beam_config_set_sf_channel

	@ %def process_beam_config_set_sf_channel
	@ Print an informative startup message.
	<<Process config: process beam config: TBP>>=
	procedure :: sf_startup_message => process_beam_config_sf_startup_message
	<<Process config: sub interfaces>>=
	module subroutine process_beam_config_sf_startup_message &
	(beam_config, sf_string, unit)
	class(process_beam_config_t), intent(in) :: beam_config
	type(string_t), intent(in) :: sf_string
	integer, intent(in), optional :: unit
	end subroutine process_beam_config_sf_startup_message
	<<Process config: procedures>>=
	module subroutine process_beam_config_sf_startup_message &
	(beam_config, sf_string, unit)
	class(process_beam_config_t), intent(in) :: beam_config
	type(string_t), intent(in) :: sf_string
	integer, intent(in), optional :: unit
	if (beam_config%n_strfun > 0) then
	call msg_message ("Beam structure: " // char (sf_string), unit = unit)
	write (msg_buffer, "(A,3(1x,I0,1x,A))") &
	"Beam structure:", &
	beam_config%n_channel, "channels,", &
	beam_config%n_sfpar, "dimensions"
	call msg_message (unit = unit)
	if (beam_config%sf_trace) then
	call msg_message ("Beam structure: tracing &
	&values in '" // char (beam_config%sf_trace_file) // "'")
	end if
	end if
	end subroutine process_beam_config_sf_startup_message

	@ %def process_beam_config_startup_message
	@ Return the PDF set currently in use, if any. This should be unique,
	so we scan the structure functions until we get a nonzero number.

	(This implies that if the PDF set is not unique (e.g., proton and
	photon structure used together), this does not work correctly.)
	<<Process config: process beam config: TBP>>=
	procedure :: get_pdf_set => process_beam_config_get_pdf_set
	<<Process config: sub interfaces>>=
	module function process_beam_config_get_pdf_set &
	(beam_config) result (pdf_set)
	class(process_beam_config_t), intent(in) :: beam_config
	integer :: pdf_set
	end function process_beam_config_get_pdf_set
	<<Process config: procedures>>=
	module function process_beam_config_get_pdf_set (beam_config) result (pdf_set)
	class(process_beam_config_t), intent(in) :: beam_config
	integer :: pdf_set
	integer :: i
	pdf_set = 0
	if (allocated (beam_config%sf)) then
	do i = 1, size (beam_config%sf)
	pdf_set = beam_config%sf(i)%get_pdf_set ()
	if (pdf_set /= 0) return
	end do
	end if
	end function process_beam_config_get_pdf_set

	@ %def process_beam_config_get_pdf_set
	@ Return the beam file.
	<<Process config: process beam config: TBP>>=
	procedure :: get_beam_file => process_beam_config_get_beam_file
	<<Process config: sub interfaces>>=
	module function process_beam_config_get_beam_file &
	(beam_config) result (file)
	class(process_beam_config_t), intent(in) :: beam_config
	type(string_t) :: file
	end function process_beam_config_get_beam_file
	<<Process config: procedures>>=
	module function process_beam_config_get_beam_file (beam_config) result (file)
	class(process_beam_config_t), intent(in) :: beam_config
	type(string_t) :: file
	integer :: i
	file = ""
	if (allocated (beam_config%sf)) then
	do i = 1, size (beam_config%sf)
	file = beam_config%sf(i)%get_beam_file ()
	if (file /= "") return
	end do
	end if
	end function process_beam_config_get_beam_file

	@ %def process_beam_config_get_beam_file
	@ Compute the MD5 sum for the complete beam setup. We rely on the
	default output of [[write]] to contain all relevant data.

	This is done only once, when the MD5 sum is still empty.
	<<Process config: process beam config: TBP>>=
	procedure :: compute_md5sum => process_beam_config_compute_md5sum
	<<Process config: sub interfaces>>=
	module subroutine process_beam_config_compute_md5sum (beam_config)
	class(process_beam_config_t), intent(inout) :: beam_config
	end subroutine process_beam_config_compute_md5sum
	<<Process config: procedures>>=
	module subroutine process_beam_config_compute_md5sum (beam_config)
	class(process_beam_config_t), intent(inout) :: beam_config
	integer :: u
	if (beam_config%md5sum == "") then
	u = free_unit ()
	open (u, status = "scratch", action = "readwrite")
	call beam_config%write (u, verbose=.true.)
	rewind (u)
	beam_config%md5sum = md5sum (u)
	close (u)
	end if
	end subroutine process_beam_config_compute_md5sum

	@ %def process_beam_config_compute_md5sum
	@
	<<Process config: process beam config: TBP>>=
	procedure :: get_md5sum => process_beam_config_get_md5sum
	<<Process config: sub interfaces>>=
	pure module function process_beam_config_get_md5sum &
	(beam_config) result (md5)
	character(32) :: md5
	class(process_beam_config_t), intent(in) :: beam_config
	end function process_beam_config_get_md5sum
	<<Process config: procedures>>=
	pure module function process_beam_config_get_md5sum (beam_config) result (md5)
	character(32) :: md5
	class(process_beam_config_t), intent(in) :: beam_config
	md5 = beam_config%md5sum
	end function process_beam_config_get_md5sum

	@ %def process_beam_config_get_md5sum
	@
	<<Process config: process beam config: TBP>>=
	procedure :: has_structure_function => &
	process_beam_config_has_structure_function
	<<Process config: sub interfaces>>=
	pure module function process_beam_config_has_structure_function &
	(beam_config) result (has_sf)
	logical :: has_sf
	class(process_beam_config_t), intent(in) :: beam_config
	end function process_beam_config_has_structure_function
	<<Process config: procedures>>=
	pure module function process_beam_config_has_structure_function &
	(beam_config) result (has_sf)
	logical :: has_sf
	class(process_beam_config_t), intent(in) :: beam_config
	has_sf = beam_config%n_strfun > 0
	end function process_beam_config_has_structure_function

	@ %def process_beam_config_has_structure_function
	@
	\subsection{Process components}
	A process component is an individual contribution to a process
	(scattering or decay) which needs not be physical. The sum over all
	components should be physical.

	The [[index]] indentifies this component within its parent process.

	The actual process component is stored in the [[core]] subobject. We
	use a polymorphic subobject instead of an extension of
	[[process_component_t]], because the individual entries in the array
	of process components can have different types. In short,
	[[process_component_t]] is a wrapper for the actual process variants.

	If the [[active]] flag is false, we should skip this component. This happens
	if the associated process has vanishing matrix element.

	The index array [[i_term]] points to the individual terms generated by
	this component. The indices refer to the parent process.

	The index [[i_mci]] is the index of the MC integrator and parameter set which
	are associated to this process component.
	<<Process config: public>>=
	public :: process_component_t
	<<Process config: types>>=
	type :: process_component_t
	type(process_component_def_t), pointer :: config => null ()
	integer :: index = 0
	logical :: active = .false.
	integer, dimension(:), allocatable :: i_term
	integer :: i_mci = 0
	class(phs_config_t), allocatable :: phs_config
	character(32) :: md5sum_phs = ""
	integer :: component_type = COMP_DEFAULT
	contains
	<<Process config: process component: TBP>>
	end type process_component_t

	@ %def process_component_t
	@ Finalizer. The MCI template may (potentially) need a finalizer. The process
	configuration finalizer may include closing an open scratch file.
	<<Process config: process component: TBP>>=
	procedure :: final => process_component_final
	<<Process config: sub interfaces>>=
	module subroutine process_component_final (object)
	class(process_component_t), intent(inout) :: object
	end subroutine process_component_final
	<<Process config: procedures>>=
	module subroutine process_component_final (object)
	class(process_component_t), intent(inout) :: object
	if (allocated (object%phs_config)) then
	call object%phs_config%final ()
	end if
	end subroutine process_component_final

	@ %def process_component_final
	@ The meaning of [[verbose]] depends on the process variant.
	<<Process config: process component: TBP>>=
	procedure :: write => process_component_write
	<<Process config: sub interfaces>>=
	module subroutine process_component_write (object, unit)
	class(process_component_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine process_component_write
	<<Process config: procedures>>=
	module subroutine process_component_write (object, unit)
	class(process_component_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%config)) then
	write (u, "(1x,A,I0)") "Component #", object%index
	call object%config%write (u)
	if (object%md5sum_phs /= "") then
	write (u, "(3x,A,A,A)") "MD5 sum (phs) = '", &
	object%md5sum_phs, "'"
	end if
	else
	write (u, "(1x,A)") "Process component: [not allocated]"
	end if
	if (.not. object%active) then
	write (u, "(1x,A)") "[Inactive]"
	return
	end if
	write (u, "(1x,A)") "Referenced data:"
	if (allocated (object%i_term)) then
	write (u, "(3x,A,999(1x,I0))") "Terms =", &
	object%i_term
	else
	write (u, "(3x,A)") "Terms = [undefined]"
	end if
	if (object%i_mci /= 0) then
	write (u, "(3x,A,I0)") "MC dataset = ", object%i_mci
	else
	write (u, "(3x,A)") "MC dataset = [undefined]"
	end if
	if (allocated (object%phs_config)) then
	call object%phs_config%write (u)
	end if
	end subroutine process_component_write

	@ %def process_component_write
	@ Initialize the component.
	<<Process config: process component: TBP>>=
	procedure :: init => process_component_init
	<<Process config: sub interfaces>>=
	module subroutine process_component_init (component, &
	i_component, env, meta, config, &
	active, &
	phs_config_template)
	class(process_component_t), intent(out) :: component
	integer, intent(in) :: i_component
	type(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	type(process_config_data_t), intent(in) :: config
	logical, intent(in) :: active
	class(phs_config_t), intent(in), allocatable :: phs_config_template
	end subroutine process_component_init
	<<Process config: procedures>>=
	module subroutine process_component_init (component, &
	i_component, env, meta, config, &
	active, &
	phs_config_template)
	class(process_component_t), intent(out) :: component
	integer, intent(in) :: i_component
	type(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	type(process_config_data_t), intent(in) :: config
	logical, intent(in) :: active
	class(phs_config_t), intent(in), allocatable :: phs_config_template

	type(process_constants_t) :: data

	component%index = i_component
	component%config => &
	config%process_def%get_component_def_ptr (i_component)

	component%active = active
	if (component%active) then
	allocate (component%phs_config, source = phs_config_template)
	call env%fill_process_constants (meta%id, i_component, data)
	call component%phs_config%init (data, config%model)
	end if
	end subroutine process_component_init

	@ %def process_component_init
	@
	<<Process config: process component: TBP>>=
	procedure :: is_active => process_component_is_active
	<<Process config: sub interfaces>>=
	elemental module function process_component_is_active &
	(component) result (active)
	logical :: active
	class(process_component_t), intent(in) :: component
	end function process_component_is_active
	<<Process config: procedures>>=
	elemental module function process_component_is_active &
	(component) result (active)
	logical :: active
	class(process_component_t), intent(in) :: component
	active = component%active
	end function process_component_is_active

	@ %def process_component_is_active
	@ Finalize the phase-space configuration.
	<<Process config: process component: TBP>>=
	procedure :: configure_phs => process_component_configure_phs
	<<Process config: sub interfaces>>=
	module subroutine process_component_configure_phs &
	(component, sqrts, beam_config, rebuild, &
	ignore_mismatch, subdir)
	class(process_component_t), intent(inout) :: component
	real(default), intent(in) :: sqrts
	type(process_beam_config_t), intent(in) :: beam_config
	logical, intent(in), optional :: rebuild
	logical, intent(in), optional :: ignore_mismatch
	type(string_t), intent(in), optional :: subdir
	end subroutine process_component_configure_phs
	<<Process config: procedures>>=
	module subroutine process_component_configure_phs &
	(component, sqrts, beam_config, rebuild, &
	ignore_mismatch, subdir)
	class(process_component_t), intent(inout) :: component
	real(default), intent(in) :: sqrts
	type(process_beam_config_t), intent(in) :: beam_config
	logical, intent(in), optional :: rebuild
	logical, intent(in), optional :: ignore_mismatch
	type(string_t), intent(in), optional :: subdir
	logical :: no_strfun
	integer :: nlo_type
	no_strfun = beam_config%n_strfun == 0
	nlo_type = component%config%get_nlo_type ()
	call component%phs_config%configure (sqrts, &
	azimuthal_dependence = beam_config%azimuthal_dependence, &
	sqrts_fixed = no_strfun, &
	lab_is_cm = beam_config%lab_is_cm .and. no_strfun, &
	rebuild = rebuild, ignore_mismatch = ignore_mismatch, &
	nlo_type = nlo_type, &
	subdir = subdir)
	end subroutine process_component_configure_phs

	@ %def process_component_configure_phs
	@ The process component possesses two MD5 sums: the checksum of the
	component definition, which should be available when the component is
	initialized, and the phase-space MD5 sum, which is available after
	configuration.
	<<Process config: process component: TBP>>=
	procedure :: compute_md5sum => process_component_compute_md5sum
	<<Process config: sub interfaces>>=
	module subroutine process_component_compute_md5sum (component)
	class(process_component_t), intent(inout) :: component
	end subroutine process_component_compute_md5sum
	<<Process config: procedures>>=
	module subroutine process_component_compute_md5sum (component)
	class(process_component_t), intent(inout) :: component
	component%md5sum_phs = component%phs_config%get_md5sum ()
	end subroutine process_component_compute_md5sum

	@ %def process_component_compute_md5sum
	@ Match phase-space channels with structure-function channels, where
	applicable.

	This calls a method of the [[phs_config]] phase-space implementation.
	<<Process config: process component: TBP>>=
	procedure :: collect_channels => process_component_collect_channels
	<<Process config: sub interfaces>>=
	module subroutine process_component_collect_channels (component, coll)
	class(process_component_t), intent(inout) :: component
	type(phs_channel_collection_t), intent(inout) :: coll
	end subroutine process_component_collect_channels
	<<Process config: procedures>>=
	module subroutine process_component_collect_channels (component, coll)
	class(process_component_t), intent(inout) :: component
	type(phs_channel_collection_t), intent(inout) :: coll
	call component%phs_config%collect_channels (coll)
	end subroutine process_component_collect_channels

	@ %def process_component_collect_channels
	@
	<<Process config: process component: TBP>>=
	procedure :: get_config => process_component_get_config
	<<Process config: sub interfaces>>=
	module function process_component_get_config (component) &
	result (config)
	type(process_component_def_t) :: config
	class(process_component_t), intent(in) :: component
	end function process_component_get_config
	<<Process config: procedures>>=
	module function process_component_get_config (component) &
	result (config)
	type(process_component_def_t) :: config
	class(process_component_t), intent(in) :: component
	config = component%config
	end function process_component_get_config

	@ %def process_component_get_config
	@
	<<Process config: process component: TBP>>=
	procedure :: get_md5sum => process_component_get_md5sum
	<<Process config: sub interfaces>>=
	pure module function process_component_get_md5sum (component) result (md5)
	type(string_t) :: md5
	class(process_component_t), intent(in) :: component
	end function process_component_get_md5sum
	<<Process config: procedures>>=
	pure module function process_component_get_md5sum (component) result (md5)
	type(string_t) :: md5
	class(process_component_t), intent(in) :: component
	md5 = component%config%get_md5sum () // component%md5sum_phs
	end function process_component_get_md5sum

	@ %def process_component_get_md5sum
	@ Return the number of phase-space parameters.
	<<Process config: process component: TBP>>=
	procedure :: get_n_phs_par => process_component_get_n_phs_par
	<<Process config: sub interfaces>>=
	module function process_component_get_n_phs_par (component) result (n_par)
	class(process_component_t), intent(in) :: component
	integer :: n_par
	end function process_component_get_n_phs_par
	<<Process config: procedures>>=
	module function process_component_get_n_phs_par (component) result (n_par)
	class(process_component_t), intent(in) :: component
	integer :: n_par
	n_par = component%phs_config%get_n_par ()
	end function process_component_get_n_phs_par

	@ %def process_component_get_n_phs_par
	@
	<<Process config: process component: TBP>>=
	procedure :: get_phs_config => process_component_get_phs_config
	<<Process config: sub interfaces>>=
	module subroutine process_component_get_phs_config (component, phs_config)
	class(process_component_t), intent(in), target :: component
	class(phs_config_t), intent(out), pointer :: phs_config
	end subroutine process_component_get_phs_config
	<<Process config: procedures>>=
	module subroutine process_component_get_phs_config (component, phs_config)
	class(process_component_t), intent(in), target :: component
	class(phs_config_t), intent(out), pointer :: phs_config
	phs_config => component%phs_config
	end subroutine process_component_get_phs_config

	@ %def process_component_get_phs_config
	@
	<<Process config: process component: TBP>>=
	procedure :: get_nlo_type => process_component_get_nlo_type
	<<Process config: sub interfaces>>=
	elemental module function process_component_get_nlo_type &
	(component) result (nlo_type)
	integer :: nlo_type
	class(process_component_t), intent(in) :: component
	end function process_component_get_nlo_type
	<<Process config: procedures>>=
	elemental module function process_component_get_nlo_type &
	(component) result (nlo_type)
	integer :: nlo_type
	class(process_component_t), intent(in) :: component
	nlo_type = component%config%get_nlo_type ()
	end function process_component_get_nlo_type

	@ %def process_component_get_nlo_type
	@
	<<Process config: process component: TBP>>=
	procedure :: needs_mci_entry => process_component_needs_mci_entry
	<<Process config: sub interfaces>>=
	module function process_component_needs_mci_entry &
	(component, combined_integration) result (value)
	logical :: value
	class(process_component_t), intent(in) :: component
	logical, intent(in), optional :: combined_integration
	end function process_component_needs_mci_entry
	<<Process config: procedures>>=
	module function process_component_needs_mci_entry &
	(component, combined_integration) result (value)
	logical :: value
	class(process_component_t), intent(in) :: component
	logical, intent(in), optional :: combined_integration
	value = component%active
	if (present (combined_integration)) then
	if (combined_integration) &
	value = value .and. component%component_type <= COMP_MASTER
	end if
	end function process_component_needs_mci_entry

	@ %def process_component_needs_mci_entry
	@
	<<Process config: process component: TBP>>=
	procedure :: can_be_integrated => process_component_can_be_integrated
	<<Process config: sub interfaces>>=
	elemental module function process_component_can_be_integrated &
	(component) result (active)
	logical :: active
	class(process_component_t), intent(in) :: component
	end function process_component_can_be_integrated
	<<Process config: procedures>>=
	elemental module function process_component_can_be_integrated &
	(component) result (active)
	logical :: active
	class(process_component_t), intent(in) :: component
	active = component%config%can_be_integrated ()
	end function process_component_can_be_integrated

	@ %def process_component_can_be_integrated
	@
	\subsection{Process terms}
	For straightforward tree-level calculations, each process component
	corresponds to a unique elementary interaction. However, in the case
	of NLO calculations with subtraction terms, a process component may
	split into several separate contributions to the scattering, which are
	qualified by interactions with distinct kinematics and particle
	content. We represent their configuration as [[process_term_t]]
	objects, the actual instances will be introduced below as
	[[term_instance_t]]. In any case, the process term contains an
	elementary interaction with a definite quantum-number and momentum
	content.

	The index [[i_term_global]] identifies the term relative to the
	process.

	The index [[i_component]] identifies the process component which
	generates this term, relative to the parent process.

	The index [[i_term]] identifies the term relative to the process
	component (not the process).

	The [[data]] subobject holds all process constants.

	The number of allowed flavor/helicity/color combinations is stored as
	[[n_allowed]]. This is the total number of independent entries in the
	density matrix. For each combination, the index of the flavor,
	helicity, and color state is stored in the arrays [[flv]], [[hel]],
	and [[col]], respectively.

	The flag [[rearrange]] is true if we need to rearrange the particles of the
	hard interaction, to obtain the effective parton state.

	The interaction [[int]] holds the quantum state for the (resolved) hard
	interaction, the parent-child relations of the particles, and their momenta.
	The momenta are not filled yet; this is postponed to copies of [[int]] which
	go into the process instances.

	If recombination is in effect, we should allocate [[int_eff]] to describe the
	rearranged partonic state.

	This type is public only for use in a unit test.
	<<Process config: public>>=
	public :: process_term_t
	<<Process config: types>>=
	type :: process_term_t
	integer :: i_term_global = 0
	integer :: i_component = 0
	integer :: i_term = 0
	integer :: i_sub = 0
	integer :: i_core = 0
	integer :: n_allowed = 0
	type(process_constants_t) :: data
	real(default) :: alpha_s = 0
	integer, dimension(:), allocatable :: flv, hel, col
	integer :: n_sub, n_sub_color, n_sub_spin
	type(interaction_t) :: int
	type(interaction_t), pointer :: int_eff => null ()
	contains
	<<Process config: process term: TBP>>
	end type process_term_t

	@ %def process_term_t
	@ For the output, we skip the process constants and the tables of
	allowed quantum numbers. Those can also be read off from the
	interaction object.
	<<Process config: process term: TBP>>=
	procedure :: write => process_term_write
	<<Process config: sub interfaces>>=
	module subroutine process_term_write (term, unit)
	class(process_term_t), intent(in) :: term
	integer, intent(in), optional :: unit
	end subroutine process_term_write
	<<Process config: procedures>>=
	module subroutine process_term_write (term, unit)
	class(process_term_t), intent(in) :: term
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A,I0)") "Term #", term%i_term_global
	write (u, "(3x,A,I0)") "Process component index = ", &
	term%i_component
	write (u, "(3x,A,I0)") "Term index w.r.t. component = ", &
	term%i_term
	call write_separator (u)
	write (u, "(1x,A)") "Hard interaction:"
	call write_separator (u)
	call term%int%basic_write (u)
	end subroutine process_term_write

	@ %def process_term_write
	@ Write an account of all quantum number states and their current status.
	<<Process config: process term: TBP>>=
	procedure :: write_state_summary => process_term_write_state_summary
	<<Process config: sub interfaces>>=
	module subroutine process_term_write_state_summary (term, core, unit)
	class(process_term_t), intent(in) :: term
	class(prc_core_t), intent(in) :: core
	integer, intent(in), optional :: unit
	end subroutine process_term_write_state_summary
	<<Process config: procedures>>=
	module subroutine process_term_write_state_summary (term, core, unit)
	class(process_term_t), intent(in) :: term
	class(prc_core_t), intent(in) :: core
	integer, intent(in), optional :: unit
	integer :: u, i, f, h, c
	type(state_iterator_t) :: it
	character :: sgn
	u = given_output_unit (unit)
	write (u, "(1x,A,I0)") "Term #", term%i_term_global
	call it%init (term%int%get_state_matrix_ptr ())
	do while (it%is_valid ())
	i = it%get_me_index ()
	f = term%flv(i)
	h = term%hel(i)
	if (allocated (term%col)) then
	c = term%col(i)
	else
	c = 1
	end if
	if (core%is_allowed (term%i_term, f, h, c)) then
	sgn = "+"
	else
	sgn = " "
	end if
	write (u, "(1x,A1,1x,I0,2x)", advance="no") sgn, i
	call quantum_numbers_write (it%get_quantum_numbers (), u)
	write (u, *)
	call it%advance ()
	end do
	end subroutine process_term_write_state_summary

	@ %def process_term_write_state_summary
	@ Finalizer: the [[int]] and potentially [[int_eff]] components have a
	finalizer that we must call.
	<<Process config: process term: TBP>>=
	procedure :: final => process_term_final
	<<Process config: sub interfaces>>=
	module subroutine process_term_final (term)
	class(process_term_t), intent(inout) :: term
	end subroutine process_term_final
	<<Process config: procedures>>=
	module subroutine process_term_final (term)
	class(process_term_t), intent(inout) :: term
	call term%int%final ()
	end subroutine process_term_final

	@ %def process_term_final
	@ Initialize the term. We copy the process constants from the [[core]]
	object and set up the [[int]] hard interaction accordingly.

	The [[alpha_s]] value is useful for writing external event records. This is
	the constant value which may be overridden by an event-specific running value.
	If the model does not contain the strong coupling, the value is zero.

	The [[rearrange]] part is commented out; this or something equivalent
	could become relevant for NLO algorithms.
	<<Process config: process term: TBP>>=
	procedure :: init => process_term_init
	<<Process config: sub interfaces>>=
	module subroutine process_term_init &
	(term, i_term_global, i_component, i_term, core, model, &
	nlo_type, use_beam_pol, subtraction_method, &
	has_pdfs, n_emitters)
	class(process_term_t), intent(inout), target :: term
	integer, intent(in) :: i_term_global
	integer, intent(in) :: i_component
	integer, intent(in) :: i_term
	class(prc_core_t), intent(inout) :: core
	class(model_data_t), intent(in), target :: model
	integer, intent(in), optional :: nlo_type
	logical, intent(in), optional :: use_beam_pol
	type(string_t), intent(in), optional :: subtraction_method
	logical, intent(in), optional :: has_pdfs
	integer, intent(in), optional :: n_emitters
	end subroutine process_term_init
	<<Process config: procedures>>=
	module subroutine process_term_init &
	(term, i_term_global, i_component, i_term, core, model, &
	nlo_type, use_beam_pol, subtraction_method, &
	has_pdfs, n_emitters)
	class(process_term_t), intent(inout), target :: term
	integer, intent(in) :: i_term_global
	integer, intent(in) :: i_component
	integer, intent(in) :: i_term
	class(prc_core_t), intent(inout) :: core
	class(model_data_t), intent(in), target :: model
	integer, intent(in), optional :: nlo_type
	logical, intent(in), optional :: use_beam_pol
	type(string_t), intent(in), optional :: subtraction_method
	logical, intent(in), optional :: has_pdfs
	integer, intent(in), optional :: n_emitters
	class(modelpar_data_t), pointer :: alpha_s_ptr
	logical :: use_internal_color
	term%i_term_global = i_term_global
	term%i_component = i_component
	term%i_term = i_term
	call core%get_constants (term%data, i_term)
	alpha_s_ptr => model%get_par_data_ptr (var_str ("alphas"))
	if (associated (alpha_s_ptr)) then
	term%alpha_s = alpha_s_ptr%get_real ()
	else
	term%alpha_s = -1
	end if
	use_internal_color = .false.
	if (present (subtraction_method)) &
	use_internal_color = (char (subtraction_method) == 'omega') &
	.or. (char (subtraction_method) == 'threshold')
	call term%setup_interaction (core, model, nlo_type = nlo_type, &
	pol_beams = use_beam_pol, use_internal_color = use_internal_color, &
	has_pdfs = has_pdfs, n_emitters = n_emitters)
	end subroutine process_term_init

	@ %def process_term_init
	@ We fetch the process constants which determine the quantum numbers and
	use those to create the interaction. The interaction contains
	incoming and outgoing particles, no virtuals. The incoming particles
	are parents of the outgoing ones.

	Keeping previous \whizard\ conventions, we invert the color assignment
	(but not flavor or helicity) for the incoming particles. When the
	color-flow square matrix is evaluated, this inversion is done again,
	so in the color-flow sequence we get the color assignments of the
	matrix element.

	\textbf{Why are these four subtraction entries for structure-function
	aware interactions?} Taking the soft or collinear limit of the real-emission
	matrix element, the behavior of the parton energy fractions has to be
	taken into account. In the pure real case, $x_\oplus$ and $x_\ominus$
	are given by
	\begin{equation*}
	x_\oplus = \frac{\bar{x}_\oplus}{\sqrt{1-\xi}}
	\sqrt{\frac{2 - \xi(1-y)}{2 - \xi(1+y)}},
	\quad
	x_\ominus = \frac{\bar{x}_\ominus}{\sqrt{1-\xi}}
	\sqrt{\frac{2 - \xi(1+y)}{2 - \xi(1-y)}}.
	\end{equation*}
	In the soft limit, $\xi \to 0$, this yields $x_\oplus = \bar{x}_\oplus$
	and $x_\ominus = \bar{x}_\ominus$. In the collinear limit, $y \to 1$,
	it is $x_\oplus = \bar{x}_\oplus / (1 - \xi)$ and $x_\ominus = \bar{x}_\ominus$.
	Likewise, in the anti-collinear limit $y \to -1$, the inverse relation holds.
	We therefore have to distinguish four cases with the PDF assignments
	$f(x_\oplus) \cdot f(x_\ominus)$, $f(\bar{x}_\oplus) \cdot f(\bar{x}_\ominus)$,
	$f\left(\bar{x}_\oplus / (1-\xi)\right) \cdot f(\bar{x}_\ominus)$ and
	$f(\bar{x}_\oplus) \cdot f\left(\bar{x}_\ominus / (1-\xi)\right)$.

	The [[n_emitters]] optional argument is provided by the caller if this term
	requires spin-correlated matrix elements, and thus involves additional
	subtractions.
	<<Process config: process term: TBP>>=
	procedure :: setup_interaction => process_term_setup_interaction
	<<Process config: sub interfaces>>=
	module subroutine process_term_setup_interaction (term, core, model, &
	nlo_type, pol_beams, has_pdfs, use_internal_color, n_emitters)
	class(process_term_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	class(model_data_t), intent(in), target :: model
	logical, intent(in), optional :: pol_beams
	logical, intent(in), optional :: has_pdfs
	integer, intent(in), optional :: nlo_type
	logical, intent(in), optional :: use_internal_color
	integer, intent(in), optional :: n_emitters
	end subroutine process_term_setup_interaction
	<<Process config: procedures>>=
	module subroutine process_term_setup_interaction (term, core, model, &
	nlo_type, pol_beams, has_pdfs, use_internal_color, n_emitters)
	class(process_term_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	class(model_data_t), intent(in), target :: model
	logical, intent(in), optional :: pol_beams
	logical, intent(in), optional :: has_pdfs
	integer, intent(in), optional :: nlo_type
	logical, intent(in), optional :: use_internal_color
	integer, intent(in), optional :: n_emitters
	integer :: n, n_tot
	type(flavor_t), dimension(:), allocatable :: flv
	type(color_t), dimension(:), allocatable :: col
	type(helicity_t), dimension(:), allocatable :: hel
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	logical :: is_pol, use_color
	integer :: nlo_t, n_sub
	is_pol = .false.; if (present (pol_beams)) is_pol = pol_beams
	nlo_t = BORN; if (present (nlo_type)) nlo_t = nlo_type
	n_tot = term%data%n_in + term%data%n_out
	call count_number_of_states ()
	term%n_allowed = n
	call compute_n_sub (n_emitters, has_pdfs)
	call fill_quantum_numbers ()
	call term%int%basic_init &
	(term%data%n_in, 0, term%data%n_out, set_relations = .true.)
	select type (core)
	class is (prc_blha_t)
	call setup_states_blha_olp ()
	type is (prc_threshold_t)
	call setup_states_threshold ()
	class is (prc_external_t)
	call setup_states_other_prc_external ()
	class default
	call setup_states_omega ()
	end select
	call term%int%freeze ()
	contains
	subroutine count_number_of_states ()
	integer :: f, h, c
	n = 0
	select type (core)
	class is (prc_external_t)
	do f = 1, term%data%n_flv
	do h = 1, term%data%n_hel
	do c = 1, term%data%n_col
	n = n + 1
	end do
	end do
	end do
	class default !!! Omega and all test cores
	do f = 1, term%data%n_flv
	do h = 1, term%data%n_hel
	do c = 1, term%data%n_col
	if (core%is_allowed (term%i_term, f, h, c)) n = n + 1
	end do
	end do
	end do
	end select
	end subroutine count_number_of_states

	subroutine compute_n_sub (n_emitters, has_pdfs)
	integer, intent(in), optional :: n_emitters
	logical, intent(in), optional :: has_pdfs
	logical :: can_have_sub
	integer :: n_sub_color, n_sub_spin
	use_color = .false.; if (present (use_internal_color)) &
	use_color = use_internal_color
	can_have_sub = nlo_t == NLO_VIRTUAL .or. &
	(nlo_t == NLO_REAL .and. term%i_term_global == term%i_sub) .or. &
	nlo_t == NLO_MISMATCH .or. nlo_t == NLO_DGLAP
	n_sub_color = 0; n_sub_spin = 0
	if (can_have_sub) then
	if (.not. use_color) n_sub_color = n_tot * (n_tot - 1) / 2
	if (nlo_t == NLO_REAL) then
	if (present (n_emitters)) then
	n_sub_spin = 6 * n_emitters
	end if
	end if
	end if
	n_sub = n_sub_color + n_sub_spin
	!!! For the virtual subtraction we also need the finite virtual contribution
	!!! corresponding to the $\epsilon^0$-pole
	if (nlo_t == NLO_VIRTUAL) n_sub = n_sub + 1
	if (present (has_pdfs)) then
	if (has_pdfs &
	.and. ((nlo_t == NLO_REAL .and. can_have_sub) &
	.or. nlo_t == NLO_DGLAP)) then
	!!! necessary dummy, needs refactoring,
	!!! c.f. [[term_instance_evaluate_interaction_external_tree]]
	n_sub = n_sub + n_beams_rescaled
	end if
	end if
	term%n_sub = n_sub
	term%n_sub_color = n_sub_color
	term%n_sub_spin = n_sub_spin
	end subroutine compute_n_sub

	subroutine fill_quantum_numbers ()
	integer :: nn
	logical :: can_have_sub
	select type (core)
	class is (prc_external_t)
	can_have_sub = nlo_t == NLO_VIRTUAL .or. &
	(nlo_t == NLO_REAL .and. term%i_term_global == term%i_sub) .or. &
	nlo_t == NLO_MISMATCH .or. nlo_t == NLO_DGLAP
	if (can_have_sub) then
	nn = (n_sub + 1) * n
	else
	nn = n
	end if
	class default
	nn = n
	end select
	allocate (term%flv (nn), term%col (nn), term%hel (nn))
	allocate (flv (n_tot), col (n_tot), hel (n_tot))
	allocate (qn (n_tot))
	end subroutine fill_quantum_numbers

	subroutine setup_states_blha_olp ()
	integer :: s, f, c, h, i
	i = 0
	associate (data => term%data)
	do s = 0, n_sub
	do f = 1, data%n_flv
	do h = 1, data%n_hel
	do c = 1, data%n_col
	i = i + 1
	term%flv(i) = f
	term%hel(i) = h
	!!! Dummy-initialization of color
	term%col(i) = c
	call flv%init (data%flv_state (:,f), model)
	call color_init_from_array (col, &
	data%col_state(:,:,c), data%ghost_flag(:,c))
	call col(1:data%n_in)%invert ()
	if (is_pol) then
	select type (core)
	type is (prc_openloops_t)
	call hel%init (data%hel_state (:,h))
	call qn%init (flv, hel, col, s)
	class default
	call msg_fatal ("Polarized beams only supported by OpenLoops")
	end select
	else
	call qn%init (flv, col, s)
	end if
	call qn%tag_hard_process ()
	call term%int%add_state (qn)
	end do
	end do
	end do
	end do
	end associate
	end subroutine setup_states_blha_olp

	subroutine setup_states_threshold ()
	integer :: s, f, c, h, i
	i = 0
	n_sub = 0; if (nlo_t == NLO_VIRTUAL) n_sub = 1
	associate (data => term%data)
	do s = 0, n_sub
	do f = 1, term%data%n_flv
	do h = 1, data%n_hel
	do c = 1, data%n_col
	i = i + 1
	term%flv(i) = f
	term%hel(i) = h
	!!! Dummy-initialization of color
	term%col(i) = 1
	call flv%init (term%data%flv_state (:,f), model)
	if (is_pol) then
	call hel%init (data%hel_state (:,h))
	call qn%init (flv, hel, s)
	else
	call qn%init (flv, s)
	end if
	call qn%tag_hard_process ()
	call term%int%add_state (qn)
	end do
	end do
	end do
	end do
	end associate
	end subroutine setup_states_threshold

	subroutine setup_states_other_prc_external ()
	integer :: s, f, i, c, h
	if (is_pol) &
	call msg_fatal ("Polarized beams only supported by OpenLoops")
	i = 0
	!!! n_sub = 0; if (nlo_t == NLO_VIRTUAL) n_sub = 1
	associate (data => term%data)
	do s = 0, n_sub
	do f = 1, data%n_flv
	do h = 1, data%n_hel
	do c = 1, data%n_col
	i = i + 1
	term%flv(i) = f
	term%hel(i) = h
	!!! Dummy-initialization of color
	term%col(i) = c
	call flv%init (data%flv_state (:,f), model)
	call color_init_from_array (col, &
	data%col_state(:,:,c), data%ghost_flag(:,c))
	call col(1:data%n_in)%invert ()
	call qn%init (flv, col, s)
	call qn%tag_hard_process ()
	call term%int%add_state (qn)
	end do
	end do
	end do
	end do
	end associate
	end subroutine setup_states_other_prc_external

	subroutine setup_states_omega ()
	integer :: f, h, c, i
	i = 0
	associate (data => term%data)
	do f = 1, data%n_flv
	do h = 1, data%n_hel
	do c = 1, data%n_col
	if (core%is_allowed (term%i_term, f, h, c)) then
	i = i + 1
	term%flv(i) = f
	term%hel(i) = h
	term%col(i) = c
	call flv%init (data%flv_state(:,f), model)
	call color_init_from_array (col, &
	data%col_state(:,:,c), &
	data%ghost_flag(:,c))
	call col(:data%n_in)%invert ()
	call hel%init (data%hel_state(:,h))
	call qn%init (flv, col, hel)
	call qn%tag_hard_process ()
	call term%int%add_state (qn)
	end if
	end do
	end do
	end do
	end associate
	end subroutine setup_states_omega

	end subroutine process_term_setup_interaction

	@ %def process_term_setup_interaction
	@
	<<Process config: process term: TBP>>=
	procedure :: get_process_constants => process_term_get_process_constants
	<<Process config: sub interfaces>>=
	module subroutine process_term_get_process_constants &
	(term, prc_constants)
	class(process_term_t), intent(inout) :: term
	type(process_constants_t), intent(out) :: prc_constants
	end subroutine process_term_get_process_constants
	<<Process config: procedures>>=
	module subroutine process_term_get_process_constants &
	(term, prc_constants)
	class(process_term_t), intent(inout) :: term
	type(process_constants_t), intent(out) :: prc_constants
	prc_constants = term%data
	end subroutine process_term_get_process_constants

	@ %def process_term_get_process_constants
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process call statistics}
	Very simple object for statistics. Could be moved to a more basic chapter.
	<<[[process_counter.f90]]>>=
	<<File header>>

	module process_counter

	<<Standard module head>>

	<<Process counter: public>>

	<<Process counter: parameters>>

	<<Process counter: types>>

	interface
	<<Process counter: sub interfaces>>
	end interface

	end module process_counter
	@ %def process_counter
	@ This object can record process calls, categorized by evaluation
	status. It is a part of the [[mci_entry]] component below.
	<<Process counter: public>>=
	public :: process_counter_t
	<<Process counter: types>>=
	type :: process_counter_t
	integer :: total = 0
	integer :: failed_kinematics = 0
	integer :: failed_cuts = 0
	integer :: has_passed = 0
	integer :: evaluated = 0
	integer :: complete = 0
	contains
	<<Process counter: process counter: TBP>>
	end type process_counter_t

	@ %def process_counter_t
	@ Here are the corresponding numeric codes:
	<<Process counter: parameters>>=
	integer, parameter, public :: STAT_UNDEFINED = 0
	integer, parameter, public :: STAT_INITIAL = 1
	integer, parameter, public :: STAT_ACTIVATED = 2
	integer, parameter, public :: STAT_BEAM_MOMENTA = 3
	integer, parameter, public :: STAT_FAILED_KINEMATICS = 4
	integer, parameter, public :: STAT_SEED_KINEMATICS = 5
	integer, parameter, public :: STAT_HARD_KINEMATICS = 6
	integer, parameter, public :: STAT_EFF_KINEMATICS = 7
	integer, parameter, public :: STAT_FAILED_CUTS = 8
	integer, parameter, public :: STAT_PASSED_CUTS = 9
	integer, parameter, public :: STAT_EVALUATED_TRACE = 10
	integer, parameter, public :: STAT_EVENT_COMPLETE = 11

	@ %def STAT_UNDEFINED STAT_INITIAL STAT_ACTIVATED
	@ %def STAT_BEAM_MOMENTA STAT_FAILED_KINEMATICS
	@ %def STAT_SEED_KINEMATICS STAT_HARD_KINEMATICS STAT_EFF_KINEMATICS
	@ %def STAT_EVALUATED_TRACE STAT_EVENT_COMPLETE
	@ Output.
	<<Process counter: process counter: TBP>>=
	procedure :: write => process_counter_write
	<<Process counter: sub interfaces>>=
	module subroutine process_counter_write (object, unit)
	class(process_counter_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine process_counter_write
	<<Process counter: procedures>>=
	module subroutine process_counter_write (object, unit)
	class(process_counter_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	if (object%total > 0) then
	write (u, "(1x,A)") "Call statistics (current run):"
	write (u, "(3x,A,I0)") "total = ", object%total
	write (u, "(3x,A,I0)") "failed kin. = ", object%failed_kinematics
	write (u, "(3x,A,I0)") "failed cuts = ", object%failed_cuts
	write (u, "(3x,A,I0)") "passed cuts = ", object%has_passed
	write (u, "(3x,A,I0)") "evaluated = ", object%evaluated
	else
	write (u, "(1x,A)") "Call statistics (current run): [no calls]"
	end if
	end subroutine process_counter_write

	@ %def process_counter_write
	@
	<<[[process_counter_sub.f90]]>>=
	<<File header>>

	submodule (process_counter) process_counter_s

	use io_units

	implicit none

	contains

	<<Process counter: procedures>>

	end submodule process_counter_s

	@ %def process_counter_s
	@ Reset. Just enforce default initialization.
	<<Process counter: process counter: TBP>>=
	procedure :: reset => process_counter_reset
	<<Process counter: sub interfaces>>=
	module subroutine process_counter_reset (counter)
	class(process_counter_t), intent(out) :: counter
	end subroutine process_counter_reset
	<<Process counter: procedures>>=
	module subroutine process_counter_reset (counter)
	class(process_counter_t), intent(out) :: counter
	counter%total = 0
	counter%failed_kinematics = 0
	counter%failed_cuts = 0
	counter%has_passed = 0
	counter%evaluated = 0
	counter%complete = 0
	end subroutine process_counter_reset

	@ %def process_counter_reset
	@ We record an event according to the lowest status code greater or
	equal to the actual status. This is actually done by the process
	instance; the process object just copies the instance counter.
	<<Process counter: process counter: TBP>>=
	procedure :: record => process_counter_record
	<<Process counter: sub interfaces>>=
	module subroutine process_counter_record (counter, status)
	class(process_counter_t), intent(inout) :: counter
	integer, intent(in) :: status
	end subroutine process_counter_record
	<<Process counter: procedures>>=
	module subroutine process_counter_record (counter, status)
	class(process_counter_t), intent(inout) :: counter
	integer, intent(in) :: status
	if (status <= STAT_FAILED_KINEMATICS) then
	counter%failed_kinematics = counter%failed_kinematics + 1
	else if (status <= STAT_FAILED_CUTS) then
	counter%failed_cuts = counter%failed_cuts + 1
	else if (status <= STAT_PASSED_CUTS) then
	counter%has_passed = counter%has_passed + 1
	else
	counter%evaluated = counter%evaluated + 1
	end if
	counter%total = counter%total + 1
	end subroutine process_counter_record

	@ %def process_counter_record
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Multi-channel integration}
	<<[[process_mci.f90]]>>=
	<<File header>>

	module process_mci

	<<Use kinds>>
	<<Use strings>>
	use cputime
	use rng_base
	use mci_base
	use variables
	use integration_results
	use process_libraries
	use phs_base
	use process_counter
	use process_config

	<<Standard module head>>

	<<Process mci: public>>

	<<Process mci: parameters>>

	<<Process mci: types>>

	interface
	<<Process mci: sub interfaces>>
	end interface

	end module process_mci
	@ %def process_mci
	@
	<<[[process_mci_sub.f90]]>>=
	<<File header>>

	submodule (process_mci) process_mci_s

	<<Use debug>>
	use io_units
	use diagnostics
	use physics_defs
	use md5

	implicit none

	contains

	<<Process mci: procedures>>

	end submodule process_mci_s

	@ %def process_mci_s
	\subsection{Process MCI entry}
	The [[process_mci_entry_t]] block contains, for each process component that is
	integrated independently, the configuration data for its MC input parameters.
	Each input parameter set is handled by a [[mci_t]] integrator.

	The MC input parameter set is broken down into the parameters required by the
	structure-function chain and the parameters required by the phase space of the
	elementary process.

	The MD5 sum collects all information about the associated processes
	that may affect the integration. It does not contain the MCI object
	itself or integration results.

	MC integration is organized in passes. Each pass may consist of
	several iterations, and for each iteration there is a number of
	calls. We store explicitly the values that apply to the current
	pass. Previous values are archived in the [[results]] object.

	The [[counter]] receives the counter statistics from the associated
	process instance, for diagnostics.

	The [[results]] object records results, broken down in passes and iterations.
	<<Process mci: public>>=
	public :: process_mci_entry_t
	<<Process mci: types>>=
	type :: process_mci_entry_t
	integer :: i_mci = 0
	integer, dimension(:), allocatable :: i_component
	integer :: process_type = PRC_UNKNOWN
	integer :: n_par = 0
	integer :: n_par_sf = 0
	integer :: n_par_phs = 0
	character(32) :: md5sum = ""
	integer :: pass = 0
	integer :: n_it = 0
	integer :: n_calls = 0
	logical :: activate_timer = .false.
	real(default) :: error_threshold = 0
	class(mci_t), allocatable :: mci
	type(process_counter_t) :: counter
	type(integration_results_t) :: results
	logical :: negative_weights = .false.
	logical :: combined_integration = .false.
	integer :: real_partition_type = REAL_FULL
	contains
	<<Process mci: process mci entry: TBP>>
	end type process_mci_entry_t

	@ %def process_mci_entry_t
	@ Finalizer for the [[mci]] component.
	<<Process mci: process mci entry: TBP>>=
	procedure :: final => process_mci_entry_final
	<<Process mci: sub interfaces>>=
	module subroutine process_mci_entry_final (object)
	class(process_mci_entry_t), intent(inout) :: object
	end subroutine process_mci_entry_final
	<<Process mci: procedures>>=
	module subroutine process_mci_entry_final (object)
	class(process_mci_entry_t), intent(inout) :: object
	if (allocated (object%mci)) call object%mci%final ()
	end subroutine process_mci_entry_final

	@ %def process_mci_entry_final
	@ Output. Write pass/iteration information only if set (the pass
	index is nonzero). Write the MCI block only if it exists (for some
	self-tests it does not). Write results only if there are any.
	<<Process mci: process mci entry: TBP>>=
	procedure :: write => process_mci_entry_write
	<<Process mci: sub interfaces>>=
	module subroutine process_mci_entry_write (object, unit, pacify)
	class(process_mci_entry_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	end subroutine process_mci_entry_write
	<<Process mci: procedures>>=
	module subroutine process_mci_entry_write (object, unit, pacify)
	class(process_mci_entry_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A,I0)") "Associated components = ", object%i_component
	write (u, "(3x,A,I0)") "MC input parameters = ", object%n_par
	write (u, "(3x,A,I0)") "MC parameters (SF) = ", object%n_par_sf
	write (u, "(3x,A,I0)") "MC parameters (PHS) = ", object%n_par_phs
	if (object%pass > 0) then
	write (u, "(3x,A,I0)") "Current pass = ", object%pass
	write (u, "(3x,A,I0)") "Number of iterations = ", object%n_it
	write (u, "(3x,A,I0)") "Number of calls = ", object%n_calls
	end if
	if (object%md5sum /= "") then
	write (u, "(3x,A,A,A)") "MD5 sum (components) = '", object%md5sum, "'"
	end if
	if (allocated (object%mci)) then
	call object%mci%write (u)
	end if
	call object%counter%write (u)
	if (object%results%exist ()) then
	call object%results%write (u, suppress = pacify)
	call object%results%write_chain_weights (u)
	end if
	end subroutine process_mci_entry_write

	@ %def process_mci_entry_write
	@ Configure the MCI entry. This is intent(inout) since some specific settings
	may be done before this. The actual [[mci_t]] object is an instance of the
	[[mci_template]] argument, which determines the concrete types.

	In a unit-test context, the [[mci_template]] argument may be unallocated.

	We obtain the number of channels and the number of parameters separately for
	the structure-function chain and for the associated process component. We
	assume that the phase-space object has already been configured.

	We assume that there is only one process component directly associated with an
	MCI entry.
	<<Process mci: process mci entry: TBP>>=
	procedure :: configure => process_mci_entry_configure
	<<Process mci: sub interfaces>>=
	module subroutine process_mci_entry_configure (mci_entry, mci_template, &
	process_type, i_mci, i_component, component, &
	n_sfpar, rng_factory)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	class(mci_t), intent(in), allocatable :: mci_template
	integer, intent(in) :: process_type
	integer, intent(in) :: i_mci
	integer, intent(in) :: i_component
	type(process_component_t), intent(in), target :: component
	integer, intent(in) :: n_sfpar
	class(rng_factory_t), intent(inout) :: rng_factory
	end subroutine process_mci_entry_configure
	<<Process mci: procedures>>=
	module subroutine process_mci_entry_configure (mci_entry, mci_template, &
	process_type, i_mci, i_component, component, &
	n_sfpar, rng_factory)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	class(mci_t), intent(in), allocatable :: mci_template
	integer, intent(in) :: process_type
	integer, intent(in) :: i_mci
	integer, intent(in) :: i_component
	type(process_component_t), intent(in), target :: component
	integer, intent(in) :: n_sfpar
	class(rng_factory_t), intent(inout) :: rng_factory
	class(rng_t), allocatable :: rng
	associate (phs_config => component%phs_config)
	mci_entry%i_mci = i_mci
	call mci_entry%create_component_list (i_component, component%get_config ())
	mci_entry%n_par_sf = n_sfpar
	mci_entry%n_par_phs = phs_config%get_n_par ()
	mci_entry%n_par = mci_entry%n_par_sf + mci_entry%n_par_phs
	mci_entry%process_type = process_type
	if (allocated (mci_template)) then
	allocate (mci_entry%mci, source = mci_template)
	call mci_entry%mci%record_index (mci_entry%i_mci)
	call mci_entry%mci%set_dimensions &
	(mci_entry%n_par, phs_config%get_n_channel ())
	call mci_entry%mci%declare_flat_dimensions &
	(phs_config%get_flat_dimensions ())
	if (phs_config%provides_equivalences) then
	call mci_entry%mci%declare_equivalences &
	(phs_config%channel, mci_entry%n_par_sf)
	end if
	if (phs_config%provides_chains) then
	call mci_entry%mci%declare_chains (phs_config%chain)
	end if
	call rng_factory%make (rng)
	call mci_entry%mci%import_rng (rng)
	end if
	call mci_entry%results%init (process_type)
	end associate
	end subroutine process_mci_entry_configure

	@ %def process_mci_entry_configure
	@
	<<Process mci: parameters>>=
	integer, parameter, public :: REAL_FULL = 0
	integer, parameter, public :: REAL_SINGULAR = 1
	integer, parameter, public :: REAL_FINITE = 2
	@
	<<Process mci: process mci entry: TBP>>=
	procedure :: create_component_list => &
	process_mci_entry_create_component_list
	<<Process mci: sub interfaces>>=
	module subroutine process_mci_entry_create_component_list (mci_entry, &
	i_component, component_config)
	class (process_mci_entry_t), intent(inout) :: mci_entry
	integer, intent(in) :: i_component
	type(process_component_def_t), intent(in) :: component_config
	end subroutine process_mci_entry_create_component_list
	<<Process mci: procedures>>=
	module subroutine process_mci_entry_create_component_list (mci_entry, &
	i_component, component_config)
	class (process_mci_entry_t), intent(inout) :: mci_entry
	integer, intent(in) :: i_component
	type(process_component_def_t), intent(in) :: component_config
	integer, dimension(:), allocatable :: i_list
	integer :: n
	integer, save :: i_rfin_offset = 0
	if (debug_on) call msg_debug &
	(D_PROCESS_INTEGRATION, "process_mci_entry_create_component_list")
	if (mci_entry%combined_integration) then
	if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, &
	"mci_entry%real_partition_type", mci_entry%real_partition_type)
	n = get_n_components (mci_entry%real_partition_type)
	allocate (i_list (n))
	select case (mci_entry%real_partition_type)
	case (REAL_FULL)
	i_list = component_config%get_association_list ()
	allocate (mci_entry%i_component (size (i_list)))
	mci_entry%i_component = i_list
	case (REAL_SINGULAR)
	i_list = component_config%get_association_list (ASSOCIATED_REAL_FIN)
	allocate (mci_entry%i_component (size(i_list)))
	mci_entry%i_component = i_list
	case (REAL_FINITE)
	allocate (mci_entry%i_component (1))
	mci_entry%i_component(1) = &
	component_config%get_associated_real_fin () + i_rfin_offset
	i_rfin_offset = i_rfin_offset + 1
	end select
	else
	allocate (mci_entry%i_component (1))
	mci_entry%i_component(1) = i_component
	end if
	contains
	function get_n_components (real_partition_type) result (n_components)
	integer :: n_components
	integer, intent(in) :: real_partition_type
	select case (real_partition_type)
	case (REAL_FULL)
	n_components = size (component_config%get_association_list ())
	case (REAL_SINGULAR)
	n_components = size (component_config%get_association_list &
	(ASSOCIATED_REAL_FIN))
	end select
	if (debug_on) call msg_debug &
	(D_PROCESS_INTEGRATION, "n_components", n_components)
	end function get_n_components
	end subroutine process_mci_entry_create_component_list

	@ %def process_mci_entry_create_component_list
	@ Set some additional parameters.
	<<Process mci: process mci entry: TBP>>=
	procedure :: set_parameters => process_mci_entry_set_parameters
	<<Process mci: sub interfaces>>=
	module subroutine process_mci_entry_set_parameters (mci_entry, var_list)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	type(var_list_t), intent(in) :: var_list
	end subroutine process_mci_entry_set_parameters
	<<Process mci: procedures>>=
	module subroutine process_mci_entry_set_parameters (mci_entry, var_list)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	type(var_list_t), intent(in) :: var_list
	integer :: integration_results_verbosity
	real(default) :: error_threshold
	integration_results_verbosity = &
	var_list%get_ival (var_str ("integration_results_verbosity"))
	error_threshold = &
	var_list%get_rval (var_str ("error_threshold"))
	mci_entry%activate_timer = &
	var_list%get_lval (var_str ("?integration_timer"))
	call mci_entry%results%set_verbosity (integration_results_verbosity)
	call mci_entry%results%set_error_threshold (error_threshold)
	end subroutine process_mci_entry_set_parameters

	@ %def process_mci_entry_set_parameters
	@ Compute an MD5 sum that summarizes all information that could
	influence integration results, for the associated process components.
	We take the process-configuration MD5 sum which represents parameters,
	cuts, etc., the MD5 sums for the process component definitions and
	their phase space objects (which should be configured), and the beam
	configuration MD5 sum. (The QCD setup is included in the process
	configuration data MD5 sum.)

	Done only once, when the MD5 sum is still empty.
	<<Process mci: process mci entry: TBP>>=
	procedure :: compute_md5sum => process_mci_entry_compute_md5sum
	<<Process mci: sub interfaces>>=
	module subroutine process_mci_entry_compute_md5sum (mci_entry, &
	config, component, beam_config)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	type(process_config_data_t), intent(in) :: config
	type(process_component_t), dimension(:), intent(in) :: component
	type(process_beam_config_t), intent(in) :: beam_config
	end subroutine process_mci_entry_compute_md5sum
	<<Process mci: procedures>>=
	module subroutine process_mci_entry_compute_md5sum (mci_entry, &
	config, component, beam_config)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	type(process_config_data_t), intent(in) :: config
	type(process_component_t), dimension(:), intent(in) :: component
	type(process_beam_config_t), intent(in) :: beam_config
	type(string_t) :: buffer
	integer :: i
	if (mci_entry%md5sum == "") then
	buffer = config%get_md5sum () // beam_config%get_md5sum ()
	do i = 1, size (component)
	if (component(i)%is_active ()) then
	buffer = buffer // component(i)%get_md5sum ()
	end if
	end do
	mci_entry%md5sum = md5sum (char (buffer))
	end if
	if (allocated (mci_entry%mci)) then
	call mci_entry%mci%set_md5sum (mci_entry%md5sum)
	end if
	end subroutine process_mci_entry_compute_md5sum

	@ %def process_mci_entry_compute_md5sum
	@ Test the MCI sampler by calling it a given number of time, discarding the
	results. The instance should be initialized.

	The [[mci_entry]] is [[intent(inout)]] because the integrator contains
	the random-number state.
	<<Process mci: process mci entry: TBP>>=
	procedure :: sampler_test => process_mci_entry_sampler_test
	<<Process mci: sub interfaces>>=
	module subroutine process_mci_entry_sampler_test &
	(mci_entry, mci_sampler, n_calls)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	class(mci_sampler_t), intent(inout), target :: mci_sampler
	integer, intent(in) :: n_calls
	end subroutine process_mci_entry_sampler_test
	<<Process mci: procedures>>=
	module subroutine process_mci_entry_sampler_test &
	(mci_entry, mci_sampler, n_calls)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	class(mci_sampler_t), intent(inout), target :: mci_sampler
	integer, intent(in) :: n_calls
	call mci_entry%mci%sampler_test (mci_sampler, n_calls)
	end subroutine process_mci_entry_sampler_test

	@ %def process_mci_entry_sampler_test
	@ Integrate.

	The [[integrate]] method counts as an integration pass; the pass count is
	increased by one. We transfer the pass parameters (number of iterations and
	number of calls) to the actual integration routine.

	The [[mci_entry]] is [[intent(inout)]] because the integrator contains
	the random-number state.

	Note: The results are written to screen and to logfile. This behavior
	is hardcoded.
	<<Process mci: process mci entry: TBP>>=
	procedure :: integrate => process_mci_entry_integrate
	procedure :: final_integration => process_mci_entry_final_integration
	<<Process mci: sub interfaces>>=
	module subroutine process_mci_entry_integrate (mci_entry, mci_instance, &
	mci_sampler, n_it, n_calls, &
	adapt_grids, adapt_weights, final, pacify, &
	nlo_type)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	class(mci_instance_t), intent(inout) :: mci_instance
	class(mci_sampler_t), intent(inout) :: mci_sampler
	integer, intent(in) :: n_it
	integer, intent(in) :: n_calls
	logical, intent(in), optional :: adapt_grids
	logical, intent(in), optional :: adapt_weights
	logical, intent(in), optional :: final, pacify
	integer, intent(in), optional :: nlo_type
	end subroutine process_mci_entry_integrate
	module subroutine process_mci_entry_final_integration (mci_entry)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	end subroutine process_mci_entry_final_integration
	<<Process mci: procedures>>=
	module subroutine process_mci_entry_integrate (mci_entry, mci_instance, &
	mci_sampler, n_it, n_calls, &
	adapt_grids, adapt_weights, final, pacify, &
	nlo_type)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	class(mci_instance_t), intent(inout) :: mci_instance
	class(mci_sampler_t), intent(inout) :: mci_sampler
	integer, intent(in) :: n_it
	integer, intent(in) :: n_calls
	logical, intent(in), optional :: adapt_grids
	logical, intent(in), optional :: adapt_weights
	logical, intent(in), optional :: final, pacify
	integer, intent(in), optional :: nlo_type
	integer :: u_log
	u_log = logfile_unit ()
	mci_entry%pass = mci_entry%pass + 1
	mci_entry%n_it = n_it
	mci_entry%n_calls = n_calls
	if (mci_entry%pass == 1) &
	call mci_entry%mci%startup_message (n_calls = n_calls)
	call mci_entry%mci%set_timer (active = mci_entry%activate_timer)
	call mci_entry%results%display_init (screen = .true., unit = u_log)
	call mci_entry%results%new_pass ()
	if (present (nlo_type)) then
	select case (nlo_type)
	case (NLO_VIRTUAL, NLO_REAL, NLO_MISMATCH, NLO_DGLAP)
	mci_instance%negative_weights = .true.
	end select
	end if
	call mci_entry%mci%add_pass (adapt_grids, adapt_weights, final)
	call mci_entry%mci%start_timer ()
	call mci_entry%mci%integrate (mci_instance, mci_sampler, n_it, &
	n_calls, mci_entry%results, pacify = pacify)
	call mci_entry%mci%stop_timer ()
	if (signal_is_pending ()) return
	end subroutine process_mci_entry_integrate

	module subroutine process_mci_entry_final_integration (mci_entry)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	call mci_entry%results%display_final ()
	call mci_entry%time_message ()
	end subroutine process_mci_entry_final_integration

	@ %def process_mci_entry_integrate
	@ %def process_mci_entry_final_integration
	@ If appropriate, issue an informative message about the expected time
	for an event sample.
	<<Process mci: process mci entry: TBP>>=
	procedure :: get_time => process_mci_entry_get_time
	procedure :: time_message => process_mci_entry_time_message
	<<Process mci: sub interfaces>>=
	module subroutine process_mci_entry_get_time (mci_entry, time, sample)
	class(process_mci_entry_t), intent(in) :: mci_entry
	type(time_t), intent(out) :: time
	integer, intent(in) :: sample
	end subroutine process_mci_entry_get_time
	module subroutine process_mci_entry_time_message (mci_entry)
	class(process_mci_entry_t), intent(in) :: mci_entry
	end subroutine process_mci_entry_time_message
	<<Process mci: procedures>>=
	module subroutine process_mci_entry_get_time (mci_entry, time, sample)
	class(process_mci_entry_t), intent(in) :: mci_entry
	type(time_t), intent(out) :: time
	integer, intent(in) :: sample
	real(default) :: time_last_pass, efficiency, calls
	time_last_pass = mci_entry%mci%get_time ()
	calls = mci_entry%results%get_n_calls ()
	efficiency = mci_entry%mci%get_efficiency ()
	if (time_last_pass > 0 .and. calls > 0 .and. efficiency > 0) then
	time = nint (time_last_pass / calls / efficiency * sample)
	end if
	end subroutine process_mci_entry_get_time

	module subroutine process_mci_entry_time_message (mci_entry)
	class(process_mci_entry_t), intent(in) :: mci_entry
	type(time_t) :: time
	integer :: sample
	sample = 10000
	call mci_entry%get_time (time, sample)
	if (time%is_known ()) then
	call msg_message ("Time estimate for generating 10000 events: " &
	// char (time%to_string_dhms ()))
	end if
	end subroutine process_mci_entry_time_message

	@ %def process_mci_entry_time_message
	@ Prepare event generation. (For the test integrator, this does nothing. It
	is relevant for the VAMP integrator.)
	<<Process mci: process mci entry: TBP>>=
	procedure :: prepare_simulation => process_mci_entry_prepare_simulation
	<<Process mci: sub interfaces>>=
	module subroutine process_mci_entry_prepare_simulation (mci_entry)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	end subroutine process_mci_entry_prepare_simulation
	<<Process mci: procedures>>=
	module subroutine process_mci_entry_prepare_simulation (mci_entry)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	call mci_entry%mci%prepare_simulation ()
	end subroutine process_mci_entry_prepare_simulation

	@ %def process_mci_entry_prepare_simulation
	@ Generate an event. The instance should be initialized,
	otherwise event generation is directed by the [[mci]] integrator
	subobject. The integrator instance is contained in a [[mci_work]]
	subobject of the process instance, which simultaneously serves as the
	sampler object. (We avoid the anti-aliasing rules if we assume that
	the sampling itself does not involve the integrator instance contained in the
	process instance.)

	Regarding weighted events, we only take events which are valid, which
	means that they have valid kinematics and have passed cuts.
	Therefore, we have a rejection loop. For unweighted events, the
	unweighting routine should already take care of this.

	The [[keep_failed]] flag determines whether events which failed cuts
	are nevertheless produced, to be recorded with zero weight.
	Alternatively, failed events are dropped, and this fact is recorded by
	the counter [[n_dropped]].
	<<Process mci: process mci entry: TBP>>=
	procedure :: generate_weighted_event => &
	process_mci_entry_generate_weighted_event
	procedure :: generate_unweighted_event => &
	process_mci_entry_generate_unweighted_event
	<<Process mci: sub interfaces>>=
	module subroutine process_mci_entry_generate_weighted_event (mci_entry, &
	mci_instance, mci_sampler, keep_failed)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	class(mci_instance_t), intent(inout) :: mci_instance
	class(mci_sampler_t), intent(inout) :: mci_sampler
	logical, intent(in) :: keep_failed
	end subroutine process_mci_entry_generate_weighted_event
	module subroutine process_mci_entry_generate_unweighted_event &
	(mci_entry, mci_instance, mci_sampler)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	class(mci_instance_t), intent(inout) :: mci_instance
	class(mci_sampler_t), intent(inout) :: mci_sampler
	end subroutine process_mci_entry_generate_unweighted_event
	<<Process mci: procedures>>=
	module subroutine process_mci_entry_generate_weighted_event (mci_entry, &
	mci_instance, mci_sampler, keep_failed)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	class(mci_instance_t), intent(inout) :: mci_instance
	class(mci_sampler_t), intent(inout) :: mci_sampler
	logical, intent(in) :: keep_failed
	logical :: generate_new
	generate_new = .true.
	call mci_instance%reset_n_event_dropped ()
	REJECTION: do while (generate_new)
	call mci_entry%mci%generate_weighted_event (mci_instance, mci_sampler)
	if (signal_is_pending ()) return
	if (.not. mci_sampler%is_valid()) then
	if (keep_failed) then
	generate_new = .false.
	else
	call mci_instance%record_event_dropped ()
	generate_new = .true.
	end if
	else
	generate_new = .false.
	end if
	end do REJECTION
	end subroutine process_mci_entry_generate_weighted_event

	module subroutine process_mci_entry_generate_unweighted_event &
	(mci_entry, mci_instance, mci_sampler)
	class(process_mci_entry_t), intent(inout) :: mci_entry
	class(mci_instance_t), intent(inout) :: mci_instance
	class(mci_sampler_t), intent(inout) :: mci_sampler
	call mci_entry%mci%generate_unweighted_event (mci_instance, mci_sampler)
	end subroutine process_mci_entry_generate_unweighted_event

	@ %def process_mci_entry_generate_weighted_event
	@ %def process_mci_entry_generate_unweighted_event
	@ Extract results.
	<<Process mci: process mci entry: TBP>>=
	procedure :: has_integral => process_mci_entry_has_integral
	procedure :: get_integral => process_mci_entry_get_integral
	procedure :: get_error => process_mci_entry_get_error
	procedure :: get_accuracy => process_mci_entry_get_accuracy
	procedure :: get_chi2 => process_mci_entry_get_chi2
	procedure :: get_efficiency => process_mci_entry_get_efficiency
	<<Process mci: sub interfaces>>=
	module function process_mci_entry_has_integral (mci_entry) result (flag)
	class(process_mci_entry_t), intent(in) :: mci_entry
	logical :: flag
	end function process_mci_entry_has_integral
	module function process_mci_entry_get_integral (mci_entry) result (integral)
	class(process_mci_entry_t), intent(in) :: mci_entry
	real(default) :: integral
	end function process_mci_entry_get_integral
	module function process_mci_entry_get_error (mci_entry) result (error)
	class(process_mci_entry_t), intent(in) :: mci_entry
	real(default) :: error
	end function process_mci_entry_get_error
	module function process_mci_entry_get_accuracy (mci_entry) result (accuracy)
	class(process_mci_entry_t), intent(in) :: mci_entry
	real(default) :: accuracy
	end function process_mci_entry_get_accuracy
	module function process_mci_entry_get_chi2 (mci_entry) result (chi2)
	class(process_mci_entry_t), intent(in) :: mci_entry
	real(default) :: chi2
	end function process_mci_entry_get_chi2
	module function process_mci_entry_get_efficiency &
	(mci_entry) result (efficiency)
	class(process_mci_entry_t), intent(in) :: mci_entry
	real(default) :: efficiency
	end function process_mci_entry_get_efficiency
	<<Process mci: procedures>>=
	module function process_mci_entry_has_integral (mci_entry) result (flag)
	class(process_mci_entry_t), intent(in) :: mci_entry
	logical :: flag
	flag = mci_entry%results%exist ()
	end function process_mci_entry_has_integral

	module function process_mci_entry_get_integral (mci_entry) result (integral)
	class(process_mci_entry_t), intent(in) :: mci_entry
	real(default) :: integral
	integral = mci_entry%results%get_integral ()
	end function process_mci_entry_get_integral

	module function process_mci_entry_get_error (mci_entry) result (error)
	class(process_mci_entry_t), intent(in) :: mci_entry
	real(default) :: error
	error = mci_entry%results%get_error ()
	end function process_mci_entry_get_error

	module function process_mci_entry_get_accuracy (mci_entry) result (accuracy)
	class(process_mci_entry_t), intent(in) :: mci_entry
	real(default) :: accuracy
	accuracy = mci_entry%results%get_accuracy ()
	end function process_mci_entry_get_accuracy

	module function process_mci_entry_get_chi2 (mci_entry) result (chi2)
	class(process_mci_entry_t), intent(in) :: mci_entry
	real(default) :: chi2
	chi2 = mci_entry%results%get_chi2 ()
	end function process_mci_entry_get_chi2

	module function process_mci_entry_get_efficiency &
	(mci_entry) result (efficiency)
	class(process_mci_entry_t), intent(in) :: mci_entry
	real(default) :: efficiency
	efficiency = mci_entry%results%get_efficiency ()
	end function process_mci_entry_get_efficiency

	@ %def process_mci_entry_get_integral process_mci_entry_get_error
	@ %def process_mci_entry_get_accuracy process_mci_entry_get_chi2
	@ %def process_mci_entry_get_efficiency
	@ Return the MCI checksum. This may be the one used for
	configuration, but may also incorporate results, if they change the
	state of the integrator (adaptation).
	<<Process mci: process mci entry: TBP>>=
	procedure :: get_md5sum => process_mci_entry_get_md5sum
	<<Process mci: sub interfaces>>=
	pure module function process_mci_entry_get_md5sum (entry) result (md5sum)
	class(process_mci_entry_t), intent(in) :: entry
	character(32) :: md5sum
	end function process_mci_entry_get_md5sum
	<<Process mci: procedures>>=
	pure module function process_mci_entry_get_md5sum (entry) result (md5sum)
	class(process_mci_entry_t), intent(in) :: entry
	character(32) :: md5sum
	md5sum = entry%mci%get_md5sum ()
	end function process_mci_entry_get_md5sum

	@ %def process_mci_entry_get_md5sum
	@
	\subsection{MC parameter set and MCI instance}
	For each process component that is associated with a multi-channel integration
	(MCI) object, the [[mci_work_t]] object contains the currently active
	parameter set. It also holds the implementation of the [[mci_instance_t]]
	that the integrator needs for doing its work.
	<<Process mci: public>>=
	public :: mci_work_t
	<<Process mci: types>>=
	type :: mci_work_t
	type(process_mci_entry_t), pointer :: config => null ()
	real(default), dimension(:), allocatable :: x
	class(mci_instance_t), pointer :: mci => null ()
	type(process_counter_t) :: counter
	logical :: keep_failed_events = .false.
	integer :: n_event_dropped = 0
	contains
	<<Process mci: mci work: TBP>>
	end type mci_work_t

	@ %def mci_work_t
	@ First write configuration data, then the current values.
	<<Process mci: mci work: TBP>>=
	procedure :: write => mci_work_write
	<<Process mci: sub interfaces>>=
	module subroutine mci_work_write (mci_work, unit, testflag)
	class(mci_work_t), intent(in) :: mci_work
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine mci_work_write
	<<Process mci: procedures>>=
	module subroutine mci_work_write (mci_work, unit, testflag)
	class(mci_work_t), intent(in) :: mci_work
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A,I0,A)") "Active MCI instance #", &
	mci_work%config%i_mci, " ="
	write (u, "(2x)", advance="no")
	do i = 1, mci_work%config%n_par
	write (u, "(1x,F7.5)", advance="no") mci_work%x(i)
	if (i == mci_work%config%n_par_sf) &
	write (u, "(1x,'\|')", advance="no")
	end do
	write (u, *)
	if (associated (mci_work%mci)) then
	call mci_work%mci%write (u, pacify = testflag)
	call mci_work%counter%write (u)
	end if
	end subroutine mci_work_write

	@ %def mci_work_write
	@ The [[mci]] component may require finalization.
	<<Process mci: mci work: TBP>>=
	procedure :: final => mci_work_final
	<<Process mci: sub interfaces>>=
	module subroutine mci_work_final (mci_work)
	class(mci_work_t), intent(inout) :: mci_work
	end subroutine mci_work_final
	<<Process mci: procedures>>=
	module subroutine mci_work_final (mci_work)
	class(mci_work_t), intent(inout) :: mci_work
	if (associated (mci_work%mci)) then
	call mci_work%mci%final ()
	deallocate (mci_work%mci)
	end if
	end subroutine mci_work_final

	@ %def mci_work_final
	@ Initialize with the maximum length that we will need. Contents are
	not initialized.

	The integrator inside the [[mci_entry]] object is responsible for
	allocating and initializing its own instance, which is referred to by
	a pointer in the [[mci_work]] object.
	<<Process mci: mci work: TBP>>=
	procedure :: init => mci_work_init
	<<Process mci: sub interfaces>>=
	module subroutine mci_work_init (mci_work, mci_entry)
	class(mci_work_t), intent(out) :: mci_work
	type(process_mci_entry_t), intent(in), target :: mci_entry
	end subroutine mci_work_init
	<<Process mci: procedures>>=
	module subroutine mci_work_init (mci_work, mci_entry)
	class(mci_work_t), intent(out) :: mci_work
	type(process_mci_entry_t), intent(in), target :: mci_entry
	mci_work%config => mci_entry
	allocate (mci_work%x (mci_entry%n_par))
	if (allocated (mci_entry%mci)) then
	call mci_entry%mci%allocate_instance (mci_work%mci)
	call mci_work%mci%init (mci_entry%mci)
	end if
	end subroutine mci_work_init

	@ %def mci_work_init
	@ Set parameters explicitly, either all at once, or separately for the
	structure-function and process parts.
	<<Process mci: mci work: TBP>>=
	procedure :: set => mci_work_set
	procedure :: set_x_strfun => mci_work_set_x_strfun
	procedure :: set_x_process => mci_work_set_x_process
	<<Process mci: sub interfaces>>=
	module subroutine mci_work_set (mci_work, x)
	class(mci_work_t), intent(inout) :: mci_work
	real(default), dimension(:), intent(in) :: x
	end subroutine mci_work_set
	module subroutine mci_work_set_x_strfun (mci_work, x)
	class(mci_work_t), intent(inout) :: mci_work
	real(default), dimension(:), intent(in) :: x
	end subroutine mci_work_set_x_strfun
	module subroutine mci_work_set_x_process (mci_work, x)
	class(mci_work_t), intent(inout) :: mci_work
	real(default), dimension(:), intent(in) :: x
	end subroutine mci_work_set_x_process
	<<Process mci: procedures>>=
	module subroutine mci_work_set (mci_work, x)
	class(mci_work_t), intent(inout) :: mci_work
	real(default), dimension(:), intent(in) :: x
	mci_work%x = x
	end subroutine mci_work_set

	module subroutine mci_work_set_x_strfun (mci_work, x)
	class(mci_work_t), intent(inout) :: mci_work
	real(default), dimension(:), intent(in) :: x
	mci_work%x(1 : mci_work%config%n_par_sf) = x
	end subroutine mci_work_set_x_strfun

	module subroutine mci_work_set_x_process (mci_work, x)
	class(mci_work_t), intent(inout) :: mci_work
	real(default), dimension(:), intent(in) :: x
	mci_work%x(mci_work%config%n_par_sf + 1 : mci_work%config%n_par) = x
	end subroutine mci_work_set_x_process

	@ %def mci_work_set
	@ %def mci_work_set_x_strfun
	@ %def mci_work_set_x_process
	@ Return the array of active components, i.e., those that correspond
	to the currently selected MC parameter set.
	<<Process mci: mci work: TBP>>=
	procedure :: get_active_components => mci_work_get_active_components
	<<Process mci: sub interfaces>>=
	module function mci_work_get_active_components &
	(mci_work) result (i_component)
	class(mci_work_t), intent(in) :: mci_work
	integer, dimension(:), allocatable :: i_component
	end function mci_work_get_active_components
	<<Process mci: procedures>>=
	module function mci_work_get_active_components (mci_work) result (i_component)
	class(mci_work_t), intent(in) :: mci_work
	integer, dimension(:), allocatable :: i_component
	allocate (i_component (size (mci_work%config%i_component)))
	i_component = mci_work%config%i_component
	end function mci_work_get_active_components

	@ %def mci_work_get_active_components
	@ Return the active parameters as a simple array with correct length.
	Do this separately for the structure-function parameters and the
	process parameters.
	<<Process mci: mci work: TBP>>=
	procedure :: get_x_strfun => mci_work_get_x_strfun
	procedure :: get_x_process => mci_work_get_x_process
	<<Process mci: sub interfaces>>=
	pure module function mci_work_get_x_strfun (mci_work) result (x)
	class(mci_work_t), intent(in) :: mci_work
	real(default), dimension(mci_work%config%n_par_sf) :: x
	end function mci_work_get_x_strfun
	pure module function mci_work_get_x_process (mci_work) result (x)
	class(mci_work_t), intent(in) :: mci_work
	real(default), dimension(mci_work%config%n_par_phs) :: x
	end function mci_work_get_x_process
	<<Process mci: procedures>>=
	pure module function mci_work_get_x_strfun (mci_work) result (x)
	class(mci_work_t), intent(in) :: mci_work
	real(default), dimension(mci_work%config%n_par_sf) :: x
	x = mci_work%x(1 : mci_work%config%n_par_sf)
	end function mci_work_get_x_strfun

	pure module function mci_work_get_x_process (mci_work) result (x)
	class(mci_work_t), intent(in) :: mci_work
	real(default), dimension(mci_work%config%n_par_phs) :: x
	x = mci_work%x(mci_work%config%n_par_sf + 1 : mci_work%config%n_par)
	end function mci_work_get_x_process

	@ %def mci_work_get_x_strfun
	@ %def mci_work_get_x_process
	@ Initialize and finalize event generation for the specified MCI
	entry. This also resets the counter.
	<<Process mci: mci work: TBP>>=
	procedure :: init_simulation => mci_work_init_simulation
	procedure :: final_simulation => mci_work_final_simulation
	<<Process mci: sub interfaces>>=
	module subroutine mci_work_final_simulation (mci_work)
	class(mci_work_t), intent(inout) :: mci_work
	end subroutine mci_work_final_simulation
	module subroutine mci_work_init_simulation &
	(mci_work, safety_factor, keep_failed_events)
	class(mci_work_t), intent(inout) :: mci_work
	real(default), intent(in), optional :: safety_factor
	logical, intent(in), optional :: keep_failed_events
	end subroutine mci_work_init_simulation
	<<Process mci: procedures>>=
	module subroutine mci_work_init_simulation &
	(mci_work, safety_factor, keep_failed_events)
	class(mci_work_t), intent(inout) :: mci_work
	real(default), intent(in), optional :: safety_factor
	logical, intent(in), optional :: keep_failed_events
	call mci_work%mci%init_simulation (safety_factor)
	call mci_work%counter%reset ()
	if (present (keep_failed_events)) &
	mci_work%keep_failed_events = keep_failed_events
	end subroutine mci_work_init_simulation

	module subroutine mci_work_final_simulation (mci_work)
	class(mci_work_t), intent(inout) :: mci_work
	call mci_work%mci%final_simulation ()
	end subroutine mci_work_final_simulation

	@ %def mci_work_init_simulation
	@ %def mci_work_final_simulation
	@ Counter.
	<<Process mci: mci work: TBP>>=
	procedure :: reset_counter => mci_work_reset_counter
	procedure :: record_call => mci_work_record_call
	procedure :: get_counter => mci_work_get_counter
	<<Process mci: sub interfaces>>=
	module subroutine mci_work_reset_counter (mci_work)
	class(mci_work_t), intent(inout) :: mci_work
	end subroutine mci_work_reset_counter
	module subroutine mci_work_record_call (mci_work, status)
	class(mci_work_t), intent(inout) :: mci_work
	integer, intent(in) :: status
	end subroutine mci_work_record_call
	pure module function mci_work_get_counter (mci_work) result (counter)
	class(mci_work_t), intent(in) :: mci_work
	type(process_counter_t) :: counter
	end function mci_work_get_counter
	<<Process mci: procedures>>=
	module subroutine mci_work_reset_counter (mci_work)
	class(mci_work_t), intent(inout) :: mci_work
	call mci_work%counter%reset ()
	end subroutine mci_work_reset_counter

	module subroutine mci_work_record_call (mci_work, status)
	class(mci_work_t), intent(inout) :: mci_work
	integer, intent(in) :: status
	call mci_work%counter%record (status)
	end subroutine mci_work_record_call

	pure module function mci_work_get_counter (mci_work) result (counter)
	class(mci_work_t), intent(in) :: mci_work
	type(process_counter_t) :: counter
	counter = mci_work%counter
	end function mci_work_get_counter

	@ %def mci_work_reset_counter
	@ %def mci_work_record_call
	@ %def mci_work_get_counter
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process component manager}
	<<[[pcm.f90]]>>=
	<<File header>>

	module pcm

	<<Use kinds>>
	<<Use strings>>
	use lorentz
	use model_data, only: model_data_t
	use models, only: model_t
	use quantum_numbers, only: quantum_numbers_t, quantum_numbers_mask_t
	use variables, only: var_list_t
	use nlo_data, only: nlo_settings_t
	use nlo_data, only: fks_template_t
	use nlo_data, only: FKS_DEFAULT, FKS_RESONANCES
	use mci_base, only: mci_t
	use phs_base, only: phs_config_t
	use mappings, only: mapping_defaults_t
	use phs_forests, only: phs_parameters_t
	use phs_fks, only: isr_kinematics_t, real_kinematics_t
	use phs_fks, only: phs_identifier_t
	use fks_regions, only: region_data_t
	use phs_fks, only: phs_fks_generator_t
	use phs_fks, only: dalitz_plot_t
	use phs_fks, only: phs_fks_config_t, get_filtered_resonance_histories
	use dispatch_phase_space, only: dispatch_phs
	use real_subtraction, only: real_subtraction_t, soft_mismatch_t
	use real_subtraction, only: INTEGRATION, FIXED_ORDER_EVENTS
	use real_subtraction, only: real_partition_t, powheg_damping_simple_t
	use real_subtraction, only: real_partition_fixed_order_t
	use virtual, only: virtual_t
	use dglap_remnant, only: dglap_remnant_t
	use blha_config, only: blha_master_t

	use pcm_base
	use process_config
	use process_mci, only: process_mci_entry_t
	use process_mci, only: REAL_SINGULAR, REAL_FINITE

	<<Standard module head>>

	<<PCM: public>>

	<<PCM: types>>

	interface
	<<PCM: sub interfaces>>
	end interface

	contains

	<<PCM: main procedures>>

	end module pcm
	@ %def pcm
	@
	<<[[pcm_sub.f90]]>>=
	<<File header>>

	submodule (pcm) pcm_s

	<<Use debug>>
	use constants, only: zero, two
	use diagnostics
	use phs_points, only: assignment(=)
	use io_units, only: free_unit
	use os_interface
	use process_constants, only: process_constants_t
	use physics_defs
	use flavors, only: flavor_t
	use interactions, only: interaction_t
	use dispatch_fks, only: dispatch_fks_setup
	use process_libraries, only: process_component_def_t
	use resonances, only: resonance_history_t, resonance_history_set_t
	use prc_threshold, only: threshold_def_t
	use blha_olp_interfaces, only: prc_blha_t
	!!! Intel oneAPI 2022/23 regression workaround
	use quantum_numbers, only: quantum_numbers_t
	use mappings, only: mapping_defaults_t
	use phs_base, only: phs_config_t
	use phs_forests, only: phs_parameters_t
	use mci_base, only: mci_t
	use model_data, only: model_data_t
	use models, only: model_t
	use variables, only: var_list_t
	use blha_config, only: blha_master_t
	use process_mci, only: process_mci_entry_t

	implicit none

	contains

	<<PCM: procedures>>

	end submodule pcm_s

	@ %def pcm_s
	@
	\subsection{Default process component manager}
	This is the configuration object which has the duty of allocating the
	corresponding instance. The default version is trivial.
	<<PCM: public>>=
	public :: pcm_default_t
	<<PCM: types>>=
	type, extends (pcm_t) :: pcm_default_t
	contains
	<<PCM: pcm default: TBP>>
	end type pcm_default_t

	@ %def pcm_default_t
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<PCM: pcm default: TBP>>=
	procedure :: allocate_workspace => pcm_default_allocate_workspace
	<<PCM: main procedures>>=
	subroutine pcm_default_allocate_workspace (pcm, work)
	class(pcm_default_t), intent(in) :: pcm
	class(pcm_workspace_t), intent(inout), allocatable :: work
	allocate (pcm_default_workspace_t :: work)
	end subroutine pcm_default_allocate_workspace

	@ %def pcm_default_allocate_workspace
	@
	Finalizer: apply to core manager.
	<<PCM: pcm default: TBP>>=
	procedure :: final => pcm_default_final
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_final (pcm)
	class(pcm_default_t), intent(inout) :: pcm
	end subroutine pcm_default_final
	<<PCM: procedures>>=
	module subroutine pcm_default_final (pcm)
	class(pcm_default_t), intent(inout) :: pcm
	end subroutine pcm_default_final

	@ %def pcm_default_final
	@
	<<PCM: pcm default: TBP>>=
	procedure :: is_nlo => pcm_default_is_nlo
	<<PCM: sub interfaces>>=
	module function pcm_default_is_nlo (pcm) result (is_nlo)
	logical :: is_nlo
	class(pcm_default_t), intent(in) :: pcm
	end function pcm_default_is_nlo
	<<PCM: procedures>>=
	module function pcm_default_is_nlo (pcm) result (is_nlo)
	logical :: is_nlo
	class(pcm_default_t), intent(in) :: pcm
	is_nlo = .false.
	end function pcm_default_is_nlo

	@ %def pcm_default_is_nlo
	@
	Initialize configuration data, using environment variables.
	<<PCM: pcm default: TBP>>=
	procedure :: init => pcm_default_init
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_init (pcm, env, meta)
	class(pcm_default_t), intent(out) :: pcm
	type(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	end subroutine pcm_default_init
	<<PCM: procedures>>=
	module subroutine pcm_default_init (pcm, env, meta)
	class(pcm_default_t), intent(out) :: pcm
	type(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	pcm%has_pdfs = env%has_pdfs ()
	call pcm%set_blha_defaults &
	(env%has_polarized_beams (), env%get_var_list_ptr ())
	pcm%os_data = env%get_os_data ()
	end subroutine pcm_default_init

	@ %def pcm_default_init
	@
	<<PCM: types>>=
	type, extends (pcm_workspace_t) :: pcm_default_workspace_t
	contains
	<<PCM: pcm instance default: TBP>>
	end type pcm_default_workspace_t

	@ %def pcm_default_workspace_t
	@
	<<PCM: pcm instance default: TBP>>=
	procedure :: final => pcm_default_workspace_final
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_workspace_final (pcm_work)
	class(pcm_default_workspace_t), intent(inout) :: pcm_work
	end subroutine pcm_default_workspace_final
	<<PCM: procedures>>=
	module subroutine pcm_default_workspace_final (pcm_work)
	class(pcm_default_workspace_t), intent(inout) :: pcm_work
	end subroutine pcm_default_workspace_final

	@ %def pcm_default_workspace_final
	@
	<<PCM: pcm instance default: TBP>>=
	procedure :: is_nlo => pcm_default_workspace_is_nlo
	<<PCM: sub interfaces>>=
	module function pcm_default_workspace_is_nlo (pcm_work) result (is_nlo)
	logical :: is_nlo
	class(pcm_default_workspace_t), intent(inout) :: pcm_work
	end function pcm_default_workspace_is_nlo
	<<PCM: procedures>>=
	module function pcm_default_workspace_is_nlo (pcm_work) result (is_nlo)
	logical :: is_nlo
	class(pcm_default_workspace_t), intent(inout) :: pcm_work
	is_nlo = .false.
	end function pcm_default_workspace_is_nlo

	@ %def pcm_default_workspace_is_nlo
	@
	\subsection{Implementations for the default manager}
	Categorize components. Nothing to do here, all components are of Born type.
	<<PCM: pcm default: TBP>>=
	procedure :: categorize_components => pcm_default_categorize_components
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_categorize_components (pcm, config)
	class(pcm_default_t), intent(inout) :: pcm
	type(process_config_data_t), intent(in) :: config
	end subroutine pcm_default_categorize_components
	<<PCM: procedures>>=
	module subroutine pcm_default_categorize_components (pcm, config)
	class(pcm_default_t), intent(inout) :: pcm
	type(process_config_data_t), intent(in) :: config
	end subroutine pcm_default_categorize_components

	@ %def pcm_default_categorize_components
	@
	\subsubsection{Phase-space configuration}
	Default setup for tree processes: a single phase-space configuration that is
	valid for all components.
	<<PCM: pcm default: TBP>>=
	procedure :: init_phs_config => pcm_default_init_phs_config
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_init_phs_config &
	(pcm, phs_entry, meta, env, phs_par, mapping_defs)
	class(pcm_default_t), intent(inout) :: pcm
	type(process_phs_config_t), &
	dimension(:), allocatable, intent(out) :: phs_entry
	type(process_metadata_t), intent(in) :: meta
	type(process_environment_t), intent(in) :: env
	type(mapping_defaults_t), intent(in) :: mapping_defs
	type(phs_parameters_t), intent(in) :: phs_par
	end subroutine pcm_default_init_phs_config
	<<PCM: procedures>>=
	module subroutine pcm_default_init_phs_config &
	(pcm, phs_entry, meta, env, phs_par, mapping_defs)
	class(pcm_default_t), intent(inout) :: pcm
	type(process_phs_config_t), &
	dimension(:), allocatable, intent(out) :: phs_entry
	type(process_metadata_t), intent(in) :: meta
	type(process_environment_t), intent(in) :: env
	type(mapping_defaults_t), intent(in) :: mapping_defs
	type(phs_parameters_t), intent(in) :: phs_par
	allocate (phs_entry (1))
	allocate (pcm%i_phs_config (pcm%n_components), source=1)
	call dispatch_phs (phs_entry(1)%phs_config, &
	env%get_var_list_ptr (), &
	env%get_os_data (), &
	meta%id, &
	mapping_defs, phs_par)
	end subroutine pcm_default_init_phs_config

	@ %def pcm_default_init_phs_config
	@
	\subsubsection{Core management}
	The default component manager assigns one core per component. We allocate and
	configure the core objects, using the process-component configuration data.
	<<PCM: pcm default: TBP>>=
	procedure :: allocate_cores => pcm_default_allocate_cores
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_allocate_cores (pcm, config, core_entry)
	class(pcm_default_t), intent(inout) :: pcm
	type(process_config_data_t), intent(in) :: config
	type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
	end subroutine pcm_default_allocate_cores
	<<PCM: procedures>>=
	module subroutine pcm_default_allocate_cores (pcm, config, core_entry)
	class(pcm_default_t), intent(inout) :: pcm
	type(process_config_data_t), intent(in) :: config
	type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
	type(process_component_def_t), pointer :: component_def
	integer :: i
	allocate (pcm%i_core (pcm%n_components), source = 0)
	pcm%n_cores = pcm%n_components
	allocate (core_entry (pcm%n_cores))
	do i = 1, pcm%n_cores
	pcm%i_core(i) = i
	core_entry(i)%i_component = i
	component_def => config%process_def%get_component_def_ptr (i)
	core_entry(i)%core_def => component_def%get_core_def_ptr ()
	core_entry(i)%active = component_def%can_be_integrated ()
	end do
	end subroutine pcm_default_allocate_cores

	@ %def pcm_default_allocate_cores
	@ Extra code is required for certain core types (threshold) or if BLHA uses an
	external OLP (Born only, this case) for getting its matrix elements.
	<<PCM: pcm default: TBP>>=
	procedure :: prepare_any_external_code => &
	pcm_default_prepare_any_external_code
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_prepare_any_external_code &
	(pcm, core_entry, i_core, libname, model, var_list)
	class(pcm_default_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	integer, intent(in) :: i_core
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	type(var_list_t), intent(in) :: var_list
	end subroutine pcm_default_prepare_any_external_code
	<<PCM: procedures>>=
	module subroutine pcm_default_prepare_any_external_code &
	(pcm, core_entry, i_core, libname, model, var_list)
	class(pcm_default_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	integer, intent(in) :: i_core
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	type(var_list_t), intent(in) :: var_list
	if (core_entry%active) then
	associate (core => core_entry%core)
	if (core%needs_external_code ()) then
	call core%prepare_external_code &
	(core%data%flv_state, &
	var_list, pcm%os_data, libname, model, i_core, .false.)
	end if
	call core%set_equivalent_flv_hel_indices ()
	end associate
	end if
	end subroutine pcm_default_prepare_any_external_code

	@ %def pcm_default_prepare_any_external_code
	@ Allocate and configure the BLHA record for a specific core, assuming that
	the core type requires it. In the default case, this is a Born
	configuration.
	<<PCM: pcm default: TBP>>=
	procedure :: setup_blha => pcm_default_setup_blha
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_setup_blha (pcm, core_entry)
	class(pcm_default_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	end subroutine pcm_default_setup_blha
	<<PCM: procedures>>=
	module subroutine pcm_default_setup_blha (pcm, core_entry)
	class(pcm_default_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	allocate (core_entry%blha_config, source = pcm%blha_defaults)
	call core_entry%blha_config%set_born ()
	end subroutine pcm_default_setup_blha

	@ %def pcm_default_setup_blha
	@ Apply the configuration, using [[pcm]] data.
	<<PCM: pcm default: TBP>>=
	procedure :: prepare_blha_core => pcm_default_prepare_blha_core
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_prepare_blha_core (pcm, core_entry, model)
	class(pcm_default_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	class(model_data_t), intent(in), target :: model
	end subroutine pcm_default_prepare_blha_core
	<<PCM: procedures>>=
	module subroutine pcm_default_prepare_blha_core (pcm, core_entry, model)
	class(pcm_default_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	class(model_data_t), intent(in), target :: model
	integer :: n_in
	integer :: n_legs
	integer :: n_flv
	integer :: n_hel
	select type (core => core_entry%core)
	class is (prc_blha_t)
	associate (blha_config => core_entry%blha_config)
	n_in = core%data%n_in
	n_legs = core%data%get_n_tot ()
	n_flv = core%data%n_flv
	n_hel = blha_config%get_n_hel (core%data%flv_state (1:n_in,1), model)
	call core%init_blha (blha_config, n_in, n_legs, n_flv, n_hel)
	call core%init_driver (pcm%os_data)
	end associate
	end select
	end subroutine pcm_default_prepare_blha_core

	@ %def pcm_default_prepare_blha_core
	@ Read the method settings from the variable list and store them in the BLHA
	master. This version: no NLO flag.
	<<PCM: pcm default: TBP>>=
	procedure :: set_blha_methods => pcm_default_set_blha_methods
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_set_blha_methods (pcm, blha_master, var_list)
	class(pcm_default_t), intent(inout) :: pcm
	type(blha_master_t), intent(inout) :: blha_master
	type(var_list_t), intent(in) :: var_list
	end subroutine pcm_default_set_blha_methods
	<<PCM: procedures>>=
	module subroutine pcm_default_set_blha_methods (pcm, blha_master, var_list)
	class(pcm_default_t), intent(inout) :: pcm
	type(blha_master_t), intent(inout) :: blha_master
	type(var_list_t), intent(in) :: var_list
	call blha_master%set_methods (.false., var_list)
	end subroutine pcm_default_set_blha_methods

	@ %def pcm_default_set_blha_methods
	@ Produce the LO and NLO flavor-state tables (as far as available), as
	appropriate for BLHA configuration.

	The default version looks at the first process core only, to get the Born
	data. (Multiple cores are thus unsupported.) The NLO flavor table is left
	unallocated.
	<<PCM: pcm default: TBP>>=
	procedure :: get_blha_flv_states => pcm_default_get_blha_flv_states
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_get_blha_flv_states &
	(pcm, core_entry, flv_born, flv_real)
	class(pcm_default_t), intent(in) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	integer, dimension(:,:), allocatable, intent(out) :: flv_born
	integer, dimension(:,:), allocatable, intent(out) :: flv_real
	end subroutine pcm_default_get_blha_flv_states
	<<PCM: procedures>>=
	module subroutine pcm_default_get_blha_flv_states &
	(pcm, core_entry, flv_born, flv_real)
	class(pcm_default_t), intent(in) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	integer, dimension(:,:), allocatable, intent(out) :: flv_born
	integer, dimension(:,:), allocatable, intent(out) :: flv_real
	flv_born = core_entry(1)%core%data%flv_state
	end subroutine pcm_default_get_blha_flv_states

	@ %def pcm_default_get_blha_flv_states
	@ Allocate and configure the MCI (multi-channel integrator) records. There is
	one record per active process component. Second procedure: call the MCI
	dispatcher with default-setup arguments.
	<<PCM: pcm default: TBP>>=
	procedure :: setup_mci => pcm_default_setup_mci
	procedure :: call_dispatch_mci => pcm_default_call_dispatch_mci
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_setup_mci (pcm, mci_entry)
	class(pcm_default_t), intent(inout) :: pcm
	type(process_mci_entry_t), &
	dimension(:), allocatable, intent(out) :: mci_entry
	end subroutine pcm_default_setup_mci
	module subroutine pcm_default_call_dispatch_mci (pcm, &
	dispatch_mci, var_list, process_id, mci_template)
	class(pcm_default_t), intent(inout) :: pcm
	procedure(dispatch_mci_proc) :: dispatch_mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	class(mci_t), allocatable, intent(out) :: mci_template
	end subroutine pcm_default_call_dispatch_mci
	<<PCM: procedures>>=
	module subroutine pcm_default_setup_mci (pcm, mci_entry)
	class(pcm_default_t), intent(inout) :: pcm
	type(process_mci_entry_t), &
	dimension(:), allocatable, intent(out) :: mci_entry
	class(mci_t), allocatable :: mci_template
	integer :: i, i_mci
	pcm%n_mci = count (pcm%component_active)
	allocate (pcm%i_mci (pcm%n_components), source = 0)
	i_mci = 0
	do i = 1, pcm%n_components
	if (pcm%component_active(i)) then
	i_mci = i_mci + 1
	pcm%i_mci(i) = i_mci
	end if
	end do
	allocate (mci_entry (pcm%n_mci))
	end subroutine pcm_default_setup_mci

	module subroutine pcm_default_call_dispatch_mci (pcm, &
	dispatch_mci, var_list, process_id, mci_template)
	class(pcm_default_t), intent(inout) :: pcm
	procedure(dispatch_mci_proc) :: dispatch_mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	class(mci_t), allocatable, intent(out) :: mci_template
	call dispatch_mci (mci_template, var_list, process_id)
	end subroutine pcm_default_call_dispatch_mci

	@ %def pcm_default_setup_mci
	@ %def pcm_default_call_dispatch_mci
	@ Nothing left to do for the default algorithm.
	<<PCM: pcm default: TBP>>=
	procedure :: complete_setup => pcm_default_complete_setup
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_complete_setup &
	(pcm, core_entry, component, model)
	class(pcm_default_t), intent(inout) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	type(process_component_t), dimension(:), intent(inout) :: component
	type(model_t), intent(in), target :: model
	end subroutine pcm_default_complete_setup
	<<PCM: procedures>>=
	module subroutine pcm_default_complete_setup &
	(pcm, core_entry, component, model)
	class(pcm_default_t), intent(inout) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	type(process_component_t), dimension(:), intent(inout) :: component
	type(model_t), intent(in), target :: model
	end subroutine pcm_default_complete_setup

	@ %def pcm_default_complete_setup
	@
	\subsubsection{Component management}
	Initialize a single component. We require all process-configuration blocks,
	and specific templates for the phase-space and integrator configuration.

	We also provide the current component index [[i]] and the [[active]] flag.

	In the default mode, all components are marked as master components.
	<<PCM: pcm default: TBP>>=
	procedure :: init_component => pcm_default_init_component
	<<PCM: sub interfaces>>=
	module subroutine pcm_default_init_component (pcm, component, i, active, &
	phs_config, env, meta, config)
	class(pcm_default_t), intent(in) :: pcm
	type(process_component_t), intent(out) :: component
	integer, intent(in) :: i
	logical, intent(in) :: active
	class(phs_config_t), allocatable, intent(in) :: phs_config
	type(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	type(process_config_data_t), intent(in) :: config
	end subroutine pcm_default_init_component
	<<PCM: procedures>>=
	module subroutine pcm_default_init_component (pcm, component, i, active, &
	phs_config, env, meta, config)
	class(pcm_default_t), intent(in) :: pcm
	type(process_component_t), intent(out) :: component
	integer, intent(in) :: i
	logical, intent(in) :: active
	class(phs_config_t), allocatable, intent(in) :: phs_config
	type(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	type(process_config_data_t), intent(in) :: config
	call component%init (i, &
	env, meta, config, &
	active, &
	phs_config)
	component%component_type = COMP_MASTER
	end subroutine pcm_default_init_component

	@ %def pcm_default_init_component
	@
	\subsection{NLO process component manager}
	The NLO-aware version of the process-component manager.

	This is the configuration object, which has the duty of allocating the
	corresponding instance. This is the nontrivial NLO version.
	<<PCM: public>>=
	public :: pcm_nlo_t
	<<PCM: types>>=
	type, extends (pcm_t) :: pcm_nlo_t
	type(string_t) :: id
	logical :: combined_integration = .false.
	logical :: vis_fks_regions = .false.
	integer, dimension(:), allocatable :: nlo_type
	integer, dimension(:), allocatable :: nlo_type_core
	integer, dimension(:), allocatable :: component_type
	integer :: i_born = 0
	integer :: i_real = 0
	integer :: i_sub = 0
	type(nlo_settings_t) :: settings
	type(region_data_t) :: region_data
	logical :: use_real_partition = .false.
	logical :: use_real_singular = .false.
	real(default) :: real_partition_scale = 0
	class(real_partition_t), allocatable :: real_partition
	type(dalitz_plot_t) :: dalitz_plot
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn_real, qn_born
	contains
	<<PCM: pcm nlo: TBP>>
	end type pcm_nlo_t

	@ %def pcm_nlo_t
	@
	Initialize configuration data, using environment variables.
	<<PCM: pcm nlo: TBP>>=
	procedure :: init => pcm_nlo_init
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_init (pcm, env, meta)
	class(pcm_nlo_t), intent(out) :: pcm
	type(process_metadata_t), intent(in) :: meta
	type(process_environment_t), intent(in) :: env
	end subroutine pcm_nlo_init
	<<PCM: procedures>>=
	module subroutine pcm_nlo_init (pcm, env, meta)
	class(pcm_nlo_t), intent(out) :: pcm
	type(process_metadata_t), intent(in) :: meta
	type(process_environment_t), intent(in) :: env
	type(var_list_t), pointer :: var_list
	type(fks_template_t) :: fks_template
	pcm%id = meta%id
	pcm%has_pdfs = env%has_pdfs ()
	var_list => env%get_var_list_ptr ()
	call dispatch_fks_setup (fks_template, var_list)
	call pcm%settings%init (var_list, fks_template)
	pcm%combined_integration = &
	var_list%get_lval (var_str ('?combined_nlo_integration'))
	select case (char (var_list%get_sval (var_str ("$real_partition_mode"))))
	case ("default", "off")
	pcm%use_real_partition = .false.
	pcm%use_real_singular = .false.
	case ("all", "on", "singular")
	pcm%use_real_partition = .true.
	pcm%use_real_singular = .true.
	case ("finite")
	pcm%use_real_partition = .true.
	pcm%use_real_singular = .false.
	case default
	call msg_fatal ("The real partition mode can only be " // &
	"default, off, all, on, singular or finite.")
	end select
	pcm%real_partition_scale = &
	var_list%get_rval (var_str ("real_partition_scale"))
	pcm%vis_fks_regions = &
	var_list%get_lval (var_str ("?vis_fks_regions"))
	call pcm%set_blha_defaults &
	(env%has_polarized_beams (), env%get_var_list_ptr ())
	pcm%os_data = env%get_os_data ()
	end subroutine pcm_nlo_init

	@ %def pcm_nlo_init
	@ Init/rewrite NLO settings without the FKS template.
	<<PCM: pcm nlo: TBP>>=
	procedure :: init_nlo_settings => pcm_nlo_init_nlo_settings
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_init_nlo_settings (pcm, var_list)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(var_list_t), intent(in), target :: var_list
	end subroutine pcm_nlo_init_nlo_settings
	<<PCM: procedures>>=
	module subroutine pcm_nlo_init_nlo_settings (pcm, var_list)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(var_list_t), intent(in), target :: var_list
	call pcm%settings%init (var_list)
	end subroutine pcm_nlo_init_nlo_settings

	@ %def pcm_nlo_init_nlo_settings
	@
	As appropriate for the NLO/FKS algorithm, the category defined by the
	process, is called [[nlo_type]]. We refine this by setting the component
	category [[component_type]] separately.

	The component types [[COMP_MISMATCH]], [[COMP_PDF]], [[COMP_SUB]] are set only
	if the algorithm uses combined integration. Otherwise, they are set to
	[[COMP_DEFAULT]].

	The component type [[COMP_REAL]] is further distinguished between
	[[COMP_REAL_SING]] or [[COMP_REAL_FIN]], if the algorithm uses real
	partitions. The former acts as a reference component for the latter, and we
	always assume that it is the first real component.

	Each component is assigned its own core. Exceptions: the finite-real
	component gets the same core as the singular-real component. The mismatch
	component gets the same core as the subtraction component.

	TODO wk 2018: this convention for real components can be improved.
	Check whether all component types should be assigned, not just for combined
	integration.
	<<PCM: pcm nlo: TBP>>=
	procedure :: categorize_components => pcm_nlo_categorize_components
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_categorize_components (pcm, config)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(process_config_data_t), intent(in) :: config
	end subroutine pcm_nlo_categorize_components
	<<PCM: procedures>>=
	module subroutine pcm_nlo_categorize_components (pcm, config)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(process_config_data_t), intent(in) :: config
	type(process_component_def_t), pointer :: component_def
	integer :: i
	allocate (pcm%nlo_type (pcm%n_components), source = COMPONENT_UNDEFINED)
	allocate (pcm%component_type (pcm%n_components), source = COMP_DEFAULT)
	do i = 1, pcm%n_components
	component_def => config%process_def%get_component_def_ptr (i)
	pcm%nlo_type(i) = component_def%get_nlo_type ()
	if (pcm%combined_integration) then
	select case (pcm%nlo_type(i))
	case (BORN)
	pcm%i_born = i
	pcm%component_type(i) = COMP_MASTER
	case (NLO_REAL)
	pcm%component_type(i) = COMP_REAL
	case (NLO_VIRTUAL)
	pcm%component_type(i) = COMP_VIRT
	case (NLO_MISMATCH)
	pcm%component_type(i) = COMP_MISMATCH
	case (NLO_DGLAP)
	pcm%component_type(i) = COMP_PDF
	case (NLO_SUBTRACTION)
	pcm%component_type(i) = COMP_SUB
	pcm%i_sub = i
	end select
	else
	select case (pcm%nlo_type(i))
	case (BORN)
	pcm%i_born = i
	pcm%component_type(i) = COMP_MASTER
	case (NLO_REAL)
	pcm%component_type(i) = COMP_REAL
	case (NLO_VIRTUAL)
	pcm%component_type(i) = COMP_VIRT
	case (NLO_MISMATCH)
	pcm%component_type(i) = COMP_MISMATCH
	case (NLO_SUBTRACTION)
	pcm%i_sub = i
	end select
	end if
	end do
	call refine_real_type ( &
	pack ([(i, i=1, pcm%n_components)], &
	pcm%component_type==COMP_REAL))
	contains
	subroutine refine_real_type (i_real)
	integer, dimension(:), intent(in) :: i_real
	pcm%i_real = i_real(1)
	if (pcm%use_real_partition) then
	pcm%component_type (i_real(1)) = COMP_REAL_SING
	pcm%component_type (i_real(2:)) = COMP_REAL_FIN
	end if
	end subroutine refine_real_type
	end subroutine pcm_nlo_categorize_components

	@ %def pcm_nlo_categorize_components
	@
	\subsubsection{Phase-space initial configuration}
	Setup for the NLO/PHS processes: two phase-space configurations, (1)
	Born/wood, (2) real correction/FKS. All components use either one of these
	two configurations.

	TODO wk 2018: The [[first_real_component]] identifier is really ugly.
	Nothing should rely on the ordering.
	<<PCM: pcm nlo: TBP>>=
	procedure :: init_phs_config => pcm_nlo_init_phs_config
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_init_phs_config &
	(pcm, phs_entry, meta, env, phs_par, mapping_defs)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(process_phs_config_t), &
	dimension(:), allocatable, intent(out) :: phs_entry
	type(process_metadata_t), intent(in) :: meta
	type(process_environment_t), intent(in) :: env
	type(mapping_defaults_t), intent(in) :: mapping_defs
	type(phs_parameters_t), intent(in) :: phs_par
	end subroutine pcm_nlo_init_phs_config
	<<PCM: procedures>>=
	module subroutine pcm_nlo_init_phs_config &
	(pcm, phs_entry, meta, env, phs_par, mapping_defs)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(process_phs_config_t), &
	dimension(:), allocatable, intent(out) :: phs_entry
	type(process_metadata_t), intent(in) :: meta
	type(process_environment_t), intent(in) :: env
	type(mapping_defaults_t), intent(in) :: mapping_defs
	type(phs_parameters_t), intent(in) :: phs_par
	integer :: i
	logical :: first_real_component
	allocate (phs_entry (2))
	call dispatch_phs (phs_entry(1)%phs_config, &
	env%get_var_list_ptr (), &
	env%get_os_data (), &
	meta%id, &
	mapping_defs, phs_par, &
	var_str ("wood"))
	call dispatch_phs (phs_entry(2)%phs_config, &
	env%get_var_list_ptr (), &
	env%get_os_data (), &
	meta%id, &
	mapping_defs, phs_par, &
	var_str ("fks"))
	allocate (pcm%i_phs_config (pcm%n_components), source=0)
	first_real_component = .true.
	do i = 1, pcm%n_components
	select case (pcm%nlo_type(i))
	case (BORN, NLO_VIRTUAL, NLO_SUBTRACTION)
	pcm%i_phs_config(i) = 1
	case (NLO_REAL)
	if (pcm%use_real_partition) then
	if (pcm%use_real_singular) then
	if (first_real_component) then
	pcm%i_phs_config(i) = 2
	first_real_component = .false.
	else
	pcm%i_phs_config(i) = 1
	end if
	else
	pcm%i_phs_config(i) = 1
	end if
	else
	pcm%i_phs_config(i) = 2
	end if
	case (NLO_MISMATCH, NLO_DGLAP, GKS)
	pcm%i_phs_config(i) = 2
	end select
	end do
	end subroutine pcm_nlo_init_phs_config

	@ %def pcm_nlo_init_phs_config
	@
	\subsubsection{Core management}
	Allocate the core (matrix-element interface) objects that we will need for
	evaluation. Every component gets an associated core, except for the
	real-finite and mismatch components (if any). Those components are associated
	with their previous corresponding real-singular and subtraction cores,
	respectively.

	After cores are allocated, configure the region-data block that is maintained
	by the NLO process-component manager.
	<<PCM: pcm nlo: TBP>>=
	procedure :: allocate_cores => pcm_nlo_allocate_cores
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_allocate_cores (pcm, config, core_entry)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(process_config_data_t), intent(in) :: config
	type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
	end subroutine pcm_nlo_allocate_cores
	<<PCM: procedures>>=
	module subroutine pcm_nlo_allocate_cores (pcm, config, core_entry)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(process_config_data_t), intent(in) :: config
	type(core_entry_t), dimension(:), allocatable, intent(out) :: core_entry
	type(process_component_def_t), pointer :: component_def
	integer :: i, i_core
	allocate (pcm%i_core (pcm%n_components), source = 0)
	pcm%n_cores = pcm%n_components &
	- count (pcm%component_type(:) == COMP_REAL_FIN) &
	- count (pcm%component_type(:) == COMP_MISMATCH)
	allocate (core_entry (pcm%n_cores))
	allocate (pcm%nlo_type_core (pcm%n_cores), source = BORN)
	i_core = 0
	do i = 1, pcm%n_components
	select case (pcm%component_type(i))
	case default
	i_core = i_core + 1
	pcm%i_core(i) = i_core
	pcm%nlo_type_core(i_core) = pcm%nlo_type(i)
	core_entry(i_core)%i_component = i
	component_def => config%process_def%get_component_def_ptr (i)
	core_entry(i_core)%core_def => component_def%get_core_def_ptr ()
	select case (pcm%nlo_type(i))
	case default
	core_entry(i)%active = component_def%can_be_integrated ()
	case (NLO_REAL, NLO_SUBTRACTION)
	core_entry(i)%active = .true.
	end select
	case (COMP_REAL_FIN)
	pcm%i_core(i) = pcm%i_core(pcm%i_real)
	case (COMP_MISMATCH)
	pcm%i_core(i) = pcm%i_core(pcm%i_sub)
	end select
	end do
	end subroutine pcm_nlo_allocate_cores

	@ %def pcm_nlo_allocate_cores
	@ Extra code is required for certain core types (threshold) or if BLHA uses an
	external OLP for getting its matrix elements. OMega matrix elements, by
	definition, do not need extra code. NLO-virtual or subtraction
	matrix elements always need extra code.

	More precisely: for the Born and virtual matrix element, the extra code is
	accessed only if the component is active. The radiation (real) and the
	subtraction corrections (singular and finite), extra code is accessed in any
	case.

	The flavor state is taken from the [[region_data]] table in the [[pcm]]
	record. We use the Born and real flavor-state tables as appropriate.
	<<PCM: pcm nlo: TBP>>=
	procedure :: prepare_any_external_code => &
	pcm_nlo_prepare_any_external_code
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_prepare_any_external_code &
	(pcm, core_entry, i_core, libname, model, var_list)
	class(pcm_nlo_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	integer, intent(in) :: i_core
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	type(var_list_t), intent(in) :: var_list
	end subroutine pcm_nlo_prepare_any_external_code
	<<PCM: procedures>>=
	module subroutine pcm_nlo_prepare_any_external_code &
	(pcm, core_entry, i_core, libname, model, var_list)
	class(pcm_nlo_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	integer, intent(in) :: i_core
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	type(var_list_t), intent(in) :: var_list
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	integer :: i
	call pcm%region_data%get_all_flv_states (flv_born, flv_real)
	if (core_entry%active) then
	associate (core => core_entry%core)
	if (core%needs_external_code ()) then
	select case (pcm%nlo_type (core_entry%i_component))
	case default
	call core%data%set_flv_state (flv_born)
	case (NLO_REAL)
	call core%data%set_flv_state (flv_real)
	end select
	call core%prepare_external_code &
	(core%data%flv_state, &
	var_list, pcm%os_data, libname, model, i_core, .true.)
	end if
	call core%set_equivalent_flv_hel_indices ()
	end associate
	end if
	end subroutine pcm_nlo_prepare_any_external_code

	@ %def pcm_nlo_prepare_any_external_code
	@ Allocate and configure the BLHA record for a specific core, assuming that
	the core type requires it. The configuration depends on the NLO type of the
	core.
	<<PCM: pcm nlo: TBP>>=
	procedure :: setup_blha => pcm_nlo_setup_blha
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_setup_blha (pcm, core_entry)
	class(pcm_nlo_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	end subroutine pcm_nlo_setup_blha
	<<PCM: procedures>>=
	module subroutine pcm_nlo_setup_blha (pcm, core_entry)
	class(pcm_nlo_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	allocate (core_entry%blha_config, source = pcm%blha_defaults)
	select case (pcm%nlo_type(core_entry%i_component))
	case (BORN)
	call core_entry%blha_config%set_born ()
	case (NLO_REAL)
	call core_entry%blha_config%set_real_trees ()
	case (NLO_VIRTUAL)
	call core_entry%blha_config%set_loop ()
	case (NLO_SUBTRACTION)
	call core_entry%blha_config%set_subtraction ()
	call core_entry%blha_config%set_internal_color_correlations ()
	case (NLO_DGLAP)
	call core_entry%blha_config%set_dglap ()
	end select
	end subroutine pcm_nlo_setup_blha

	@ %def pcm_nlo_setup_blha
	@ After phase-space configuration data and core entries are available, we fill
	tables and compute the remaining NLO data that will steer the integration
	and subtraction algorithm.

	There are three parts: recognize a threshold-type process core (if it exists),
	prepare the region-data tables (always), and prepare for real partitioning (if
	requested).

	The real-component phase space acts as the source for resonance-history
	information, required for the region data.
	<<PCM: pcm nlo: TBP>>=
	procedure :: complete_setup => pcm_nlo_complete_setup
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_complete_setup (pcm, core_entry, component, model)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	type(process_component_t), dimension(:), intent(inout) :: component
	type(model_t), intent(in), target :: model
	end subroutine pcm_nlo_complete_setup
	<<PCM: procedures>>=
	module subroutine pcm_nlo_complete_setup (pcm, core_entry, component, model)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	type(process_component_t), dimension(:), intent(inout) :: component
	type(model_t), intent(in), target :: model
	integer :: alpha_power, alphas_power
	call pcm%handle_threshold_core (core_entry)
	call component(1)%config%get_coupling_powers (alpha_power, alphas_power)
	call pcm%setup_region_data (core_entry, &
	model, alpha_power, alphas_power, component(pcm%i_real)%phs_config)
	call pcm%setup_real_partition ()
	end subroutine pcm_nlo_complete_setup

	@ %def pcm_nlo_complete_setup
	@ Apply the BLHA configuration to a core object, using the region data from
	[[pcm]] for determining the particle content.
	<<PCM: pcm nlo: TBP>>=
	procedure :: prepare_blha_core => pcm_nlo_prepare_blha_core
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_prepare_blha_core (pcm, core_entry, model)
	class(pcm_nlo_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	class(model_data_t), intent(in), target :: model
	end subroutine pcm_nlo_prepare_blha_core
	<<PCM: procedures>>=
	module subroutine pcm_nlo_prepare_blha_core (pcm, core_entry, model)
	class(pcm_nlo_t), intent(in) :: pcm
	type(core_entry_t), intent(inout) :: core_entry
	class(model_data_t), intent(in), target :: model
	integer :: n_in
	integer :: n_legs
	integer :: n_flv
	integer :: n_hel
	select type (core => core_entry%core)
	class is (prc_blha_t)
	associate (blha_config => core_entry%blha_config)
	n_in = core%data%n_in
	select case (pcm%nlo_type(core_entry%i_component))
	case (NLO_REAL)
	n_legs = pcm%region_data%get_n_legs_real ()
	n_flv = pcm%region_data%get_n_flv_real ()
	case default
	n_legs = pcm%region_data%get_n_legs_born ()
	n_flv = pcm%region_data%get_n_flv_born ()
	end select
	n_hel = blha_config%get_n_hel (core%data%flv_state (1:n_in,1), model)
	call core%init_blha (blha_config, n_in, n_legs, n_flv, n_hel)
	call core%init_driver (pcm%os_data)
	end associate
	end select
	end subroutine pcm_nlo_prepare_blha_core

	@ %def pcm_nlo_prepare_blha_core
	@ Read the method settings from the variable list and store them in the BLHA
	master. This version: NLO flag set.
	<<PCM: pcm nlo: TBP>>=
	procedure :: set_blha_methods => pcm_nlo_set_blha_methods
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_set_blha_methods (pcm, blha_master, var_list)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(blha_master_t), intent(inout) :: blha_master
	type(var_list_t), intent(in) :: var_list
	end subroutine pcm_nlo_set_blha_methods
	<<PCM: procedures>>=
	module subroutine pcm_nlo_set_blha_methods (pcm, blha_master, var_list)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(blha_master_t), intent(inout) :: blha_master
	type(var_list_t), intent(in) :: var_list
	call blha_master%set_methods (.true., var_list)
	call pcm%blha_defaults%set_loop_method (blha_master)
	end subroutine pcm_nlo_set_blha_methods

	@ %def pcm_nlo_set_blha_methods
	@ Produce the LO and NLO flavor-state tables (as far as available), as
	appropriate for BLHA configuration.

	The NLO version copies the tables from the region data inside [[pcm]]. The
	core array is not needed.
	<<PCM: pcm nlo: TBP>>=
	procedure :: get_blha_flv_states => pcm_nlo_get_blha_flv_states
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_get_blha_flv_states &
	(pcm, core_entry, flv_born, flv_real)
	class(pcm_nlo_t), intent(in) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	integer, dimension(:,:), allocatable, intent(out) :: flv_born
	integer, dimension(:,:), allocatable, intent(out) :: flv_real
	end subroutine pcm_nlo_get_blha_flv_states
	<<PCM: procedures>>=
	module subroutine pcm_nlo_get_blha_flv_states &
	(pcm, core_entry, flv_born, flv_real)
	class(pcm_nlo_t), intent(in) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	integer, dimension(:,:), allocatable, intent(out) :: flv_born
	integer, dimension(:,:), allocatable, intent(out) :: flv_real
	call pcm%region_data%get_all_flv_states (flv_born, flv_real)
	end subroutine pcm_nlo_get_blha_flv_states

	@ %def pcm_nlo_get_blha_flv_states
	@ Allocate and configure the MCI (multi-channel integrator) records. The
	relation depends on the [[combined_integration]] setting. If we integrate
	components separately, each component gets its own record, except for the
	subtraction component. If we do the combination, there is one record for
	the master (Born) component and a second one for the real-finite component,
	if present.

	Each entry acquires some NLO-specific initialization. Generic configuration
	follows later.

	Second procedure: call the MCI dispatcher with NLO-setup arguments.
	<<PCM: pcm nlo: TBP>>=
	procedure :: setup_mci => pcm_nlo_setup_mci
	procedure :: call_dispatch_mci => pcm_nlo_call_dispatch_mci
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_setup_mci (pcm, mci_entry)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(process_mci_entry_t), &
	dimension(:), allocatable, intent(out) :: mci_entry
	end subroutine pcm_nlo_setup_mci
	module subroutine pcm_nlo_call_dispatch_mci (pcm, &
	dispatch_mci, var_list, process_id, mci_template)
	class(pcm_nlo_t), intent(inout) :: pcm
	procedure(dispatch_mci_proc) :: dispatch_mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	class(mci_t), allocatable, intent(out) :: mci_template
	end subroutine pcm_nlo_call_dispatch_mci
	<<PCM: procedures>>=
	module subroutine pcm_nlo_setup_mci (pcm, mci_entry)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(process_mci_entry_t), &
	dimension(:), allocatable, intent(out) :: mci_entry
	class(mci_t), allocatable :: mci_template
	integer :: i, i_mci
	if (pcm%combined_integration) then
	pcm%n_mci = 1 &
	+ count (pcm%component_active(:) &
	& .and. pcm%component_type(:) == COMP_REAL_FIN)
	allocate (pcm%i_mci (pcm%n_components), source = 0)
	do i = 1, pcm%n_components
	if (pcm%component_active(i)) then
	select case (pcm%component_type(i))
	case (COMP_MASTER)
	pcm%i_mci(i) = 1
	case (COMP_REAL_FIN)
	pcm%i_mci(i) = 2
	end select
	end if
	end do
	else
	pcm%n_mci = count (pcm%component_active(:) &
	& .and. pcm%nlo_type(:) /= NLO_SUBTRACTION)
	allocate (pcm%i_mci (pcm%n_components), source = 0)
	i_mci = 0
	do i = 1, pcm%n_components
	if (pcm%component_active(i)) then
	select case (pcm%nlo_type(i))
	case default
	i_mci = i_mci + 1
	pcm%i_mci(i) = i_mci
	case (NLO_SUBTRACTION)
	end select
	end if
	end do
	end if
	allocate (mci_entry (pcm%n_mci))
	mci_entry(:)%combined_integration = pcm%combined_integration
	if (pcm%use_real_partition) then
	do i = 1, pcm%n_components
	i_mci = pcm%i_mci(i)
	if (i_mci > 0) then
	select case (pcm%component_type(i))
	case (COMP_REAL_FIN)
	mci_entry(i_mci)%real_partition_type = REAL_FINITE
	case default
	mci_entry(i_mci)%real_partition_type = REAL_SINGULAR
	end select
	end if
	end do
	end if
	end subroutine pcm_nlo_setup_mci

	module subroutine pcm_nlo_call_dispatch_mci (pcm, &
	dispatch_mci, var_list, process_id, mci_template)
	class(pcm_nlo_t), intent(inout) :: pcm
	procedure(dispatch_mci_proc) :: dispatch_mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	class(mci_t), allocatable, intent(out) :: mci_template
	call dispatch_mci (mci_template, var_list, process_id, is_nlo = .true.)
	end subroutine pcm_nlo_call_dispatch_mci

	@ %def pcm_nlo_setup_mci
	@ %def pcm_nlo_call_dispatch_mci
	@ Check for a threshold core and adjust the configuration accordingly, before
	singular region data are considered.
	<<PCM: pcm nlo: TBP>>=
	procedure :: handle_threshold_core => pcm_nlo_handle_threshold_core
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_handle_threshold_core (pcm, core_entry)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	end subroutine pcm_nlo_handle_threshold_core
	<<PCM: procedures>>=
	module subroutine pcm_nlo_handle_threshold_core (pcm, core_entry)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	integer :: i
	do i = 1, size (core_entry)
	select type (core => core_entry(i)%core_def)
	type is (threshold_def_t)
	pcm%settings%factorization_mode = FACTORIZATION_THRESHOLD
	return
	end select
	end do
	end subroutine pcm_nlo_handle_threshold_core

	@ %def pcm_nlo_handle_threshold_core
	@ Configure the singular-region tables based on the process data for the Born
	and Real (singular) cores, using also the appropriate FKS phase-space
	configuration object.

	In passing, we may create a table of resonance histories that are relevant for
	the singular-region configuration.

	TODO wk 2018: check whether [[phs_entry]] needs to be intent(inout).
	<<PCM: pcm nlo: TBP>>=
	procedure :: setup_region_data => pcm_nlo_setup_region_data
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_setup_region_data &
	(pcm, core_entry, model, alpha_power, alphas_power, phs_config)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	type(model_t), intent(in), target :: model
	integer, intent(in) :: alpha_power, alphas_power
	class(phs_config_t), intent(inout), optional :: phs_config
	end subroutine pcm_nlo_setup_region_data
	<<PCM: procedures>>=
	module subroutine pcm_nlo_setup_region_data &
	(pcm, core_entry, model, alpha_power, alphas_power, phs_config)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	type(model_t), intent(in), target :: model
	integer, intent(in) :: alpha_power, alphas_power
	class(phs_config_t), intent(inout), optional :: phs_config
	type(process_constants_t) :: data_born, data_real
	integer, dimension (:,:), allocatable :: flavor_born, flavor_real
	type(resonance_history_t), dimension(:), allocatable :: resonance_histories
	type(var_list_t), pointer :: var_list
	logical :: success
	data_born = core_entry(pcm%i_core(pcm%i_born))%core%data
	data_real = core_entry(pcm%i_core(pcm%i_real))%core%data
	call data_born%get_flv_state (flavor_born)
	call data_real%get_flv_state (flavor_real)
	call pcm%region_data%init &
	(data_born%n_in, model, flavor_born, flavor_real, &
	pcm%settings%nlo_correction_type, alpha_power, alphas_power)
	associate (template => pcm%settings%fks_template)
	if (template%mapping_type == FKS_RESONANCES) then
	if (.not. present(phs_config)) then
	call msg_bug("setup_region_data: real phase space required to setup the resonance histories.")
	end if
	select type (phs_config)
	type is (phs_fks_config_t)
	call get_filtered_resonance_histories (phs_config, &
	data_born%n_in, flavor_born, model, &
	template%excluded_resonances, &
	resonance_histories, success)
	end select
	if (.not. success) template%mapping_type = FKS_DEFAULT
	end if
	call pcm%region_data%setup_fks_mappings (template, data_born%n_in)
	!!! Check again, mapping_type might have changed
	if (template%mapping_type == FKS_RESONANCES) then
	call pcm%region_data%set_resonance_mappings (resonance_histories)
	call pcm%region_data%init_resonance_information ()
	pcm%settings%use_resonance_mappings = .true.
	end if
	end associate
	if (pcm%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
	call pcm%region_data%set_isr_pseudo_regions ()
	call pcm%region_data%split_up_interference_regions_for_threshold ()
	end if
	call pcm%region_data%compute_number_of_phase_spaces ()
	call pcm%region_data%set_i_phs_to_i_con ()
	call pcm%region_data%write_to_file &
	(pcm%id, pcm%vis_fks_regions, pcm%os_data)
	if (debug_active (D_SUBTRACTION)) &
	call pcm%region_data%check_consistency (.true.)
	end subroutine pcm_nlo_setup_region_data

	@ %def pcm_nlo_setup_region_data
	@ After region data are set up, we allocate and configure the
	[[real_partition]] objects, if requested.
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<PCM: pcm nlo: TBP>>=
	procedure :: setup_real_partition => pcm_nlo_setup_real_partition
	<<PCM: main procedures>>=
	subroutine pcm_nlo_setup_real_partition (pcm)
	class(pcm_nlo_t), intent(inout) :: pcm
	if (pcm%use_real_partition) then
	if (.not. allocated (pcm%real_partition)) then
	allocate (real_partition_fixed_order_t :: pcm%real_partition)
	select type (partition => pcm%real_partition)
	type is (real_partition_fixed_order_t)
	call pcm%region_data%get_all_ftuples (partition%fks_pairs)
	partition%scale = pcm%real_partition_scale
	end select
	end if
	end if
	end subroutine pcm_nlo_setup_real_partition

	@ %def pcm_nlo_setup_real_partition
	@
	Initialize a single component. We require all process-configuration blocks,
	and specific templates for the phase-space and integrator configuration.

	We also provide the current component index [[i]] and the [[active]] flag.
	For a subtraction component, the [[active]] flag is overridden.

	In the nlo mode, the component types have been determined before.

	TODO wk 2018: the component type need not be stored in the component; we may remove
	this when everything is controlled by [[pcm]].
	<<PCM: pcm nlo: TBP>>=
	procedure :: init_component => pcm_nlo_init_component
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_init_component (pcm, component, i, active, &
	phs_config, env, meta, config)
	class(pcm_nlo_t), intent(in) :: pcm
	type(process_component_t), intent(out) :: component
	integer, intent(in) :: i
	logical, intent(in) :: active
	class(phs_config_t), allocatable, intent(in) :: phs_config
	type(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	type(process_config_data_t), intent(in) :: config
	end subroutine pcm_nlo_init_component
	<<PCM: procedures>>=
	module subroutine pcm_nlo_init_component (pcm, component, i, active, &
	phs_config, env, meta, config)
	class(pcm_nlo_t), intent(in) :: pcm
	type(process_component_t), intent(out) :: component
	integer, intent(in) :: i
	logical, intent(in) :: active
	class(phs_config_t), allocatable, intent(in) :: phs_config
	type(process_environment_t), intent(in) :: env
	type(process_metadata_t), intent(in) :: meta
	type(process_config_data_t), intent(in) :: config
	logical :: activate
	select case (pcm%nlo_type(i))
	case default; activate = active
	case (NLO_SUBTRACTION); activate = .false.
	end select
	call component%init (i, &
	env, meta, config, &
	activate, &
	phs_config)
	component%component_type = pcm%component_type(i)
	end subroutine pcm_nlo_init_component

	@ %def pcm_nlo_init_component
	@
	Override the base method: record the active components in the PCM object, and
	report inactive components (except for the subtraction component).
	<<PCM: pcm nlo: TBP>>=
	procedure :: record_inactive_components => pcm_nlo_record_inactive_components
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_record_inactive_components (pcm, component, meta)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(process_component_t), dimension(:), intent(in) :: component
	type(process_metadata_t), intent(inout) :: meta
	end subroutine pcm_nlo_record_inactive_components
	<<PCM: procedures>>=
	module subroutine pcm_nlo_record_inactive_components (pcm, component, meta)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(process_component_t), dimension(:), intent(in) :: component
	type(process_metadata_t), intent(inout) :: meta
	integer :: i
	pcm%component_active = component%active
	do i = 1, pcm%n_components
	select case (pcm%nlo_type(i))
	case (NLO_SUBTRACTION)
	case default
	if (.not. component(i)%active) call meta%deactivate_component (i)
	end select
	end do
	end subroutine pcm_nlo_record_inactive_components

	@ %def pcm_nlo_record_inactive_components
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: core_is_radiation => pcm_nlo_core_is_radiation
	<<PCM: sub interfaces>>=
	module function pcm_nlo_core_is_radiation (pcm, i_core) result (is_rad)
	logical :: is_rad
	class(pcm_nlo_t), intent(in) :: pcm
	integer, intent(in) :: i_core
	end function pcm_nlo_core_is_radiation
	<<PCM: procedures>>=
	module function pcm_nlo_core_is_radiation (pcm, i_core) result (is_rad)
	logical :: is_rad
	class(pcm_nlo_t), intent(in) :: pcm
	integer, intent(in) :: i_core
	is_rad = pcm%nlo_type(i_core) == NLO_REAL ! .and. .not. pcm%cm%sub(i_core)
	end function pcm_nlo_core_is_radiation

	@ %def pcm_nlo_core_is_radiation
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: get_n_flv_born => pcm_nlo_get_n_flv_born
	<<PCM: sub interfaces>>=
	module function pcm_nlo_get_n_flv_born (pcm_nlo) result (n_flv)
	integer :: n_flv
	class(pcm_nlo_t), intent(in) :: pcm_nlo
	end function pcm_nlo_get_n_flv_born
	<<PCM: procedures>>=
	module function pcm_nlo_get_n_flv_born (pcm_nlo) result (n_flv)
	integer :: n_flv
	class(pcm_nlo_t), intent(in) :: pcm_nlo
	n_flv = pcm_nlo%region_data%n_flv_born
	end function pcm_nlo_get_n_flv_born

	@ %def pcm_nlo_get_n_flv_born
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: get_n_flv_real => pcm_nlo_get_n_flv_real
	<<PCM: sub interfaces>>=
	module function pcm_nlo_get_n_flv_real (pcm_nlo) result (n_flv)
	integer :: n_flv
	class(pcm_nlo_t), intent(in) :: pcm_nlo
	end function pcm_nlo_get_n_flv_real
	<<PCM: procedures>>=
	module function pcm_nlo_get_n_flv_real (pcm_nlo) result (n_flv)
	integer :: n_flv
	class(pcm_nlo_t), intent(in) :: pcm_nlo
	n_flv = pcm_nlo%region_data%n_flv_real
	end function pcm_nlo_get_n_flv_real

	@ %def pcm_nlo_get_n_flv_real
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: get_n_alr => pcm_nlo_get_n_alr
	<<PCM: sub interfaces>>=
	module function pcm_nlo_get_n_alr (pcm) result (n_alr)
	integer :: n_alr
	class(pcm_nlo_t), intent(in) :: pcm
	end function pcm_nlo_get_n_alr
	<<PCM: procedures>>=
	module function pcm_nlo_get_n_alr (pcm) result (n_alr)
	integer :: n_alr
	class(pcm_nlo_t), intent(in) :: pcm
	n_alr = pcm%region_data%n_regions
	end function pcm_nlo_get_n_alr

	@ %def pcm_nlo_get_n_alr
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: get_flv_states => pcm_nlo_get_flv_states
	<<PCM: sub interfaces>>=
	module function pcm_nlo_get_flv_states (pcm, born) result (flv)
	integer, dimension(:,:), allocatable :: flv
	class(pcm_nlo_t), intent(in) :: pcm
	logical, intent(in) :: born
	end function pcm_nlo_get_flv_states
	<<PCM: procedures>>=
	module function pcm_nlo_get_flv_states (pcm, born) result (flv)
	integer, dimension(:,:), allocatable :: flv
	class(pcm_nlo_t), intent(in) :: pcm
	logical, intent(in) :: born
	if (born) then
	flv = pcm%region_data%get_flv_states_born ()
	else
	flv = pcm%region_data%get_flv_states_real ()
	end if
	end function pcm_nlo_get_flv_states

	@ %def pcm_nlo_get_flv_states
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: get_qn => pcm_nlo_get_qn
	<<PCM: sub interfaces>>=
	module function pcm_nlo_get_qn (pcm, born) result (qn)
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	class(pcm_nlo_t), intent(in) :: pcm
	logical, intent(in) :: born
	end function pcm_nlo_get_qn
	<<PCM: procedures>>=
	module function pcm_nlo_get_qn (pcm, born) result (qn)
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	class(pcm_nlo_t), intent(in) :: pcm
	logical, intent(in) :: born
	if (born) then
	qn = pcm%qn_born
	else
	qn = pcm%qn_real
	end if
	end function pcm_nlo_get_qn

	@ %def pcm_nlo_get_qn
	@ Check if there are massive emitters. Since the mass-structure of all
	underlying Born configurations have to be the same (\textbf{This does
	not have to be the case when different components are generated at LO})
	, we just use the first one to determine this.
	<<PCM: pcm nlo: TBP>>=
	procedure :: has_massive_emitter => pcm_nlo_has_massive_emitter
	<<PCM: sub interfaces>>=
	module function pcm_nlo_has_massive_emitter (pcm) result (val)
	logical :: val
	class(pcm_nlo_t), intent(in) :: pcm
	end function pcm_nlo_has_massive_emitter
	<<PCM: procedures>>=
	module function pcm_nlo_has_massive_emitter (pcm) result (val)
	logical :: val
	class(pcm_nlo_t), intent(in) :: pcm
	integer :: i
	val = .false.
	associate (reg_data => pcm%region_data)
	do i = reg_data%n_in + 1, reg_data%n_legs_born
	if (any (i == reg_data%emitters)) &
	val = val .or. reg_data%flv_born(1)%massive(i)
	end do
	end associate
	end function pcm_nlo_has_massive_emitter

	@ %def pcm_nlo_has_massive_emitter
	@ Returns an array which specifies if the particle at position [[i]] is massive.
	<<PCM: pcm nlo: TBP>>=
	procedure :: get_mass_info => pcm_nlo_get_mass_info
	<<PCM: sub interfaces>>=
	module function pcm_nlo_get_mass_info (pcm, i_flv) result (massive)
	class(pcm_nlo_t), intent(in) :: pcm
	integer, intent(in) :: i_flv
	logical, dimension(:), allocatable :: massive
	end function pcm_nlo_get_mass_info
	<<PCM: procedures>>=
	module function pcm_nlo_get_mass_info (pcm, i_flv) result (massive)
	class(pcm_nlo_t), intent(in) :: pcm
	integer, intent(in) :: i_flv
	logical, dimension(:), allocatable :: massive
	allocate (massive (size (pcm%region_data%flv_born(i_flv)%massive)))
	massive = pcm%region_data%flv_born(i_flv)%massive
	end function pcm_nlo_get_mass_info

	@ %def pcm_nlo_get_mass_info
	@ Gfortran 7/8/9 bug, has to remain in the main module:
	<<PCM: pcm nlo: TBP>>=
	procedure :: allocate_workspace => pcm_nlo_allocate_workspace
	<<PCM: main procedures>>=
	subroutine pcm_nlo_allocate_workspace (pcm, work)
	class(pcm_nlo_t), intent(in) :: pcm
	class(pcm_workspace_t), intent(inout), allocatable :: work
	allocate (pcm_nlo_workspace_t :: work)
	end subroutine pcm_nlo_allocate_workspace

	@ %def pcm_nlo_allocate_workspace
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: init_qn => pcm_nlo_init_qn
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_init_qn (pcm, model)
	class(pcm_nlo_t), intent(inout) :: pcm
	class(model_data_t), intent(in) :: model
	end subroutine pcm_nlo_init_qn
	<<PCM: procedures>>=
	module subroutine pcm_nlo_init_qn (pcm, model)
	class(pcm_nlo_t), intent(inout) :: pcm
	class(model_data_t), intent(in) :: model
	integer, dimension(:,:), allocatable :: flv_states
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: i
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	allocate (flv_states (pcm%region_data%n_legs_born, &
	pcm%region_data%n_flv_born))
	flv_states = pcm%get_flv_states (.true.)
	allocate (pcm%qn_born (size (flv_states, dim = 1), &
	size (flv_states, dim = 2)))
	allocate (flv (size (flv_states, dim = 1)))
	allocate (qn (size (flv_states, dim = 1)))
	do i = 1, pcm%get_n_flv_born ()
	call flv%init (flv_states (:,i), model)
	call qn%init (flv)
	pcm%qn_born(:,i) = qn
	end do
	deallocate (flv); deallocate (qn)
	deallocate (flv_states)
	allocate (flv_states (pcm%region_data%n_legs_real, pcm%region_data%n_flv_real))
	flv_states = pcm%get_flv_states (.false.)
	allocate (pcm%qn_real (size (flv_states, dim = 1), size (flv_states, dim = 2)))
	allocate (flv (size (flv_states, dim = 1)))
	allocate (qn (size (flv_states, dim = 1)))
	do i = 1, pcm%get_n_flv_real ()
	call flv%init (flv_states (:,i), model)
	call qn%init (flv)
	pcm%qn_real(:,i) = qn
	end do
	end subroutine pcm_nlo_init_qn

	@ %def pcm_nlo_init_qn
	@ Gfortran 7/8/9 bug, has to remain in the main module:
	<<PCM: pcm nlo: TBP>>=
	procedure :: allocate_ps_matching => pcm_nlo_allocate_ps_matching
	<<PCM: main procedures>>=
	subroutine pcm_nlo_allocate_ps_matching (pcm)
	class(pcm_nlo_t), intent(inout) :: pcm
	if (.not. allocated (pcm%real_partition)) then
	allocate (powheg_damping_simple_t :: pcm%real_partition)
	end if
	end subroutine pcm_nlo_allocate_ps_matching

	@ %def pcm_nlo_allocate_ps_matching
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: activate_dalitz_plot => pcm_nlo_activate_dalitz_plot
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_activate_dalitz_plot (pcm, filename)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(string_t), intent(in) :: filename
	end subroutine pcm_nlo_activate_dalitz_plot
	<<PCM: procedures>>=
	module subroutine pcm_nlo_activate_dalitz_plot (pcm, filename)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(string_t), intent(in) :: filename
	call pcm%dalitz_plot%init (free_unit (), filename, .false.)
	call pcm%dalitz_plot%write_header ()
	end subroutine pcm_nlo_activate_dalitz_plot

	@ %def pcm_nlo_activate_dalitz_plot
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: register_dalitz_plot => pcm_nlo_register_dalitz_plot
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_register_dalitz_plot (pcm, emitter, p)
	class(pcm_nlo_t), intent(inout) :: pcm
	integer, intent(in) :: emitter
	type(vector4_t), intent(in), dimension(:) :: p
	end subroutine pcm_nlo_register_dalitz_plot
	<<PCM: procedures>>=
	module subroutine pcm_nlo_register_dalitz_plot (pcm, emitter, p)
	class(pcm_nlo_t), intent(inout) :: pcm
	integer, intent(in) :: emitter
	type(vector4_t), intent(in), dimension(:) :: p
	real(default) :: k0_n, k0_np1
	k0_n = p(emitter)%p(0)
	k0_np1 = p(size(p))%p(0)
	call pcm%dalitz_plot%register (k0_n, k0_np1)
	end subroutine pcm_nlo_register_dalitz_plot

	@ %def pcm_nlo_register_dalitz_plot
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: setup_phs_generator => pcm_nlo_setup_phs_generator
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_setup_phs_generator (pcm, pcm_work, generator, &
	sqrts, mode, singular_jacobian)
	class(pcm_nlo_t), intent(in) :: pcm
	type(phs_fks_generator_t), intent(inout) :: generator
	type(pcm_nlo_workspace_t), intent(in), target :: pcm_work
	real(default), intent(in) :: sqrts
	integer, intent(in), optional:: mode
	logical, intent(in), optional :: singular_jacobian
	end subroutine pcm_nlo_setup_phs_generator
	<<PCM: procedures>>=
	module subroutine pcm_nlo_setup_phs_generator (pcm, pcm_work, generator, &
	sqrts, mode, singular_jacobian)
	class(pcm_nlo_t), intent(in) :: pcm
	type(phs_fks_generator_t), intent(inout) :: generator
	type(pcm_nlo_workspace_t), intent(in), target :: pcm_work
	real(default), intent(in) :: sqrts
	integer, intent(in), optional:: mode
	logical, intent(in), optional :: singular_jacobian
	logical :: yorn
	yorn = .false.; if (present (singular_jacobian)) yorn = singular_jacobian
	call generator%connect_kinematics (pcm_work%isr_kinematics, &
	pcm_work%real_kinematics, pcm%has_massive_emitter ())
	generator%n_in = pcm%region_data%n_in
	call generator%set_sqrts_hat (sqrts)
	call generator%set_emitters (pcm%region_data%emitters)
	call generator%setup_masses (pcm%region_data%n_legs_born)
	generator%is_massive = pcm%get_mass_info (1)
	generator%singular_jacobian = yorn
	if (present (mode)) generator%mode = mode
	call generator%set_xi_and_y_bounds (pcm%settings%fks_template%xi_min, &
	pcm%settings%fks_template%y_max)
	end subroutine pcm_nlo_setup_phs_generator

	@ %def pcm_nlo_setup_phs_generator
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: final => pcm_nlo_final
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_final (pcm)
	class(pcm_nlo_t), intent(inout) :: pcm
	end subroutine pcm_nlo_final
	<<PCM: procedures>>=
	module subroutine pcm_nlo_final (pcm)
	class(pcm_nlo_t), intent(inout) :: pcm
	if (allocated (pcm%real_partition)) deallocate (pcm%real_partition)
	call pcm%dalitz_plot%final ()
	end subroutine pcm_nlo_final

	@ %def pcm_nlo_final
	@
	<<PCM: pcm nlo: TBP>>=
	procedure :: is_nlo => pcm_nlo_is_nlo
	<<PCM: sub interfaces>>=
	module function pcm_nlo_is_nlo (pcm) result (is_nlo)
	logical :: is_nlo
	class(pcm_nlo_t), intent(in) :: pcm
	end function pcm_nlo_is_nlo
	<<PCM: procedures>>=
	module function pcm_nlo_is_nlo (pcm) result (is_nlo)
	logical :: is_nlo
	class(pcm_nlo_t), intent(in) :: pcm
	is_nlo = .true.
	end function pcm_nlo_is_nlo

	@ %def pcm_nlo_is_nlo
	@ As a first implementation, it acts as a wrapper for the NLO controller
	object and the squared matrix-element collector.
	<<PCM: public>>=
	public :: pcm_nlo_workspace_t
	<<PCM: types>>=
	type, extends (pcm_workspace_t) :: pcm_nlo_workspace_t
	type(real_kinematics_t), pointer :: real_kinematics => null ()
	type(isr_kinematics_t), pointer :: isr_kinematics => null ()
	type(real_subtraction_t) :: real_sub
	type(virtual_t) :: virtual
	type(soft_mismatch_t) :: soft_mismatch
	type(dglap_remnant_t) :: dglap_remnant
	integer, dimension(:), allocatable :: i_mci_to_real_component
	contains
	<<PCM: pcm instance: TBP>>
	end type pcm_nlo_workspace_t

	@ %def pcm_nlo_workspace_t
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: set_radiation_event => pcm_nlo_workspace_set_radiation_event
	procedure :: set_subtraction_event => pcm_nlo_workspace_set_subtraction_event
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_set_radiation_event (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	end subroutine pcm_nlo_workspace_set_radiation_event
	module subroutine pcm_nlo_workspace_set_subtraction_event (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	end subroutine pcm_nlo_workspace_set_subtraction_event
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_set_radiation_event (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	pcm_work%real_sub%radiation_event = .true.
	pcm_work%real_sub%subtraction_event = .false.
	end subroutine pcm_nlo_workspace_set_radiation_event

	module subroutine pcm_nlo_workspace_set_subtraction_event (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	pcm_work%real_sub%radiation_event = .false.
	pcm_work%real_sub%subtraction_event = .true.
	end subroutine pcm_nlo_workspace_set_subtraction_event

	@ %def pcm_nlo_workspace_set_radiation_event
	@ %def pcm_nlo_workspace_set_subtraction_event
	<<PCM: pcm instance: TBP>>=
	procedure :: disable_subtraction => pcm_nlo_workspace_disable_subtraction
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_disable_subtraction (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	end subroutine pcm_nlo_workspace_disable_subtraction
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_disable_subtraction (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	pcm_work%real_sub%subtraction_deactivated = .true.
	end subroutine pcm_nlo_workspace_disable_subtraction

	@ %def pcm_nlo_workspace_disable_subtraction
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: init_config => pcm_nlo_workspace_init_config
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_init_config (pcm_work, pcm, &
	active_components, nlo_types, energy, i_real_fin, model)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	logical, intent(in), dimension(:) :: active_components
	integer, intent(in), dimension(:) :: nlo_types
	real(default), intent(in), dimension(:) :: energy
	integer, intent(in) :: i_real_fin
	class(model_data_t), intent(in) :: model
	end subroutine pcm_nlo_workspace_init_config
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_init_config (pcm_work, pcm, &
	active_components, nlo_types, energy, i_real_fin, model)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	logical, intent(in), dimension(:) :: active_components
	integer, intent(in), dimension(:) :: nlo_types
	real(default), intent(in), dimension(:) :: energy
	integer, intent(in) :: i_real_fin
	class(model_data_t), intent(in) :: model
	integer :: i_component
	if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, &
	"pcm_nlo_workspace_init_config")
	call pcm_work%init_real_and_isr_kinematics (pcm, energy)
	select type (pcm)
	type is (pcm_nlo_t)
	do i_component = 1, size (active_components)
	if (active_components(i_component) .or. &
	pcm%settings%combined_integration) then
	select case (nlo_types(i_component))
	case (NLO_REAL)
	if (i_component /= i_real_fin) then
	call pcm_work%setup_real_component (pcm, &
	pcm%settings%fks_template%subtraction_disabled)
	end if
	case (NLO_VIRTUAL)
	call pcm_work%init_virtual (pcm, model)
	case (NLO_MISMATCH)
	call pcm_work%init_soft_mismatch (pcm)
	case (NLO_DGLAP)
	call pcm_work%init_dglap_remnant (pcm)
	end select
	end if
	end do
	end select
	end subroutine pcm_nlo_workspace_init_config

	@ %def pcm_nlo_workspace_init_config
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: setup_real_component => pcm_nlo_workspace_setup_real_component
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_setup_real_component (pcm_work, pcm, &
	subtraction_disabled)
	class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
	class(pcm_t), intent(in) :: pcm
	logical, intent(in) :: subtraction_disabled
	end subroutine pcm_nlo_workspace_setup_real_component
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_setup_real_component (pcm_work, pcm, &
	subtraction_disabled)
	class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
	class(pcm_t), intent(in) :: pcm
	logical, intent(in) :: subtraction_disabled
	select type (pcm)
	type is (pcm_nlo_t)
	call pcm_work%init_real_subtraction (pcm)
	if (subtraction_disabled) call pcm_work%disable_subtraction ()
	end select
	end subroutine pcm_nlo_workspace_setup_real_component

	@ %def pcm_nlo_workspace_setup_real_component
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: init_real_and_isr_kinematics => &
	pcm_nlo_workspace_init_real_and_isr_kinematics
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_init_real_and_isr_kinematics &
	(pcm_work, pcm, energy)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	real(default), dimension(:), intent(in) :: energy
	end subroutine pcm_nlo_workspace_init_real_and_isr_kinematics
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_init_real_and_isr_kinematics &
	(pcm_work, pcm, energy)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	real(default), dimension(:), intent(in) :: energy
	integer :: n_contr
	allocate (pcm_work%real_kinematics)
	allocate (pcm_work%isr_kinematics)
	select type (pcm)
	type is (pcm_nlo_t)
	associate (region_data => pcm%region_data)
	if (allocated (region_data%alr_contributors)) then
	n_contr = size (region_data%alr_contributors)
	else if (pcm%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
	n_contr = 2
	else
	n_contr = 1
	end if
	call pcm_work%real_kinematics%init &
	(region_data%n_legs_real, region_data%n_phs, &
	region_data%n_regions, n_contr)
	if (pcm%settings%factorization_mode == FACTORIZATION_THRESHOLD) &
	call pcm_work%real_kinematics%init_onshell &
	(region_data%n_legs_real, region_data%n_phs)
	pcm_work%isr_kinematics%n_in = region_data%n_in
	end associate
	end select
	pcm_work%isr_kinematics%beam_energy = energy
	end subroutine pcm_nlo_workspace_init_real_and_isr_kinematics

	@ %def pcm_nlo_workspace_init_real_and_isr_kinematics
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: set_real_and_isr_kinematics => &
	pcm_nlo_workspace_set_real_and_isr_kinematics
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_set_real_and_isr_kinematics &
	(pcm_work, phs_identifiers, sqrts)
	class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
	type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
	real(default), intent(in) :: sqrts
	end subroutine pcm_nlo_workspace_set_real_and_isr_kinematics
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_set_real_and_isr_kinematics &
	(pcm_work, phs_identifiers, sqrts)
	class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
	type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
	real(default), intent(in) :: sqrts
	call pcm_work%real_sub%set_real_kinematics &
	(pcm_work%real_kinematics)
	call pcm_work%real_sub%set_isr_kinematics &
	(pcm_work%isr_kinematics)
	end subroutine pcm_nlo_workspace_set_real_and_isr_kinematics

	@ %def pcm_nlo_workspace_set_real_and_isr_kinematics
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: init_real_subtraction => pcm_nlo_workspace_init_real_subtraction
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_init_real_subtraction (pcm_work, pcm)
	class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
	class(pcm_t), intent(in) :: pcm
	end subroutine pcm_nlo_workspace_init_real_subtraction
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_init_real_subtraction (pcm_work, pcm)
	class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
	class(pcm_t), intent(in) :: pcm
	select type (pcm)
	type is (pcm_nlo_t)
	associate (region_data => pcm%region_data)
	call pcm_work%real_sub%init (region_data, pcm%settings)
	if (allocated (pcm%settings%selected_alr)) then
	associate (selected_alr => pcm%settings%selected_alr)
	if (any (selected_alr < 0)) then
	call msg_fatal ("Fixed alpha region must be non-negative!")
	else if (any (selected_alr > region_data%n_regions)) then
	call msg_fatal ("Fixed alpha region is larger than the"&
	&" total number of singular regions!")
	else
	allocate (pcm_work%real_sub%selected_alr &
	(size (selected_alr)))
	pcm_work%real_sub%selected_alr = selected_alr
	end if
	end associate
	end if
	end associate
	end select
	end subroutine pcm_nlo_workspace_init_real_subtraction

	@ %def pcm_nlo_workspace_init_real_subtraction
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: set_momenta_and_scales_virtual => &
	pcm_nlo_workspace_set_momenta_and_scales_virtual
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_set_momenta_and_scales_virtual &
	(pcm_work, p, ren_scale, fac_scale, es_scale)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), allocatable, intent(in) :: ren_scale
	real(default), intent(in) :: fac_scale
	real(default), allocatable, intent(in) :: es_scale
	end subroutine pcm_nlo_workspace_set_momenta_and_scales_virtual
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_set_momenta_and_scales_virtual &
	(pcm_work, p, ren_scale, fac_scale, es_scale)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), allocatable, intent(in) :: ren_scale
	real(default), intent(in) :: fac_scale
	real(default), allocatable, intent(in) :: es_scale
	associate (virtual => pcm_work%virtual)
	call virtual%set_ren_scale (ren_scale)
	call virtual%set_fac_scale (p, fac_scale)
	call virtual%set_ellis_sexton_scale (es_scale)
	end associate
	end subroutine pcm_nlo_workspace_set_momenta_and_scales_virtual

	@ %def pcm_nlo_workspace_set_momenta_and_scales_virtual
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: set_fac_scale => pcm_nlo_workspace_set_fac_scale
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_set_fac_scale (pcm_work, fac_scale)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	real(default), intent(in) :: fac_scale
	end subroutine pcm_nlo_workspace_set_fac_scale
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_set_fac_scale (pcm_work, fac_scale)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	real(default), intent(in) :: fac_scale
	pcm_work%isr_kinematics%fac_scale = fac_scale
	end subroutine pcm_nlo_workspace_set_fac_scale

	@ %def pcm_nlo_workspace_set_fac_scale
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: set_momenta => pcm_nlo_workspace_set_momenta
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_set_momenta (pcm_work, &
	p_born, p_real, i_phs, cms)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	type(vector4_t), dimension(:), intent(in) :: p_born, p_real
	integer, intent(in) :: i_phs
	logical, intent(in), optional :: cms
	end subroutine pcm_nlo_workspace_set_momenta
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_set_momenta (pcm_work, &
	p_born, p_real, i_phs, cms)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	type(vector4_t), dimension(:), intent(in) :: p_born, p_real
	integer, intent(in) :: i_phs
	logical, intent(in), optional :: cms
	logical :: yorn
	yorn = .false.; if (present (cms)) yorn = cms
	associate (kinematics => pcm_work%real_kinematics)
	if (yorn) then
	if (.not. kinematics%p_born_cms%initialized) &
	call kinematics%p_born_cms%init (size (p_born), 1)
	if (.not. kinematics%p_real_cms%initialized) &
	call kinematics%p_real_cms%init (size (p_real), 1)
	kinematics%p_born_cms%phs_point(1) = p_born
	kinematics%p_real_cms%phs_point(i_phs) = p_real
	else
	if (.not. kinematics%p_born_lab%initialized) &
	call kinematics%p_born_lab%init (size (p_born), 1)
	if (.not. kinematics%p_real_lab%initialized) &
	call kinematics%p_real_lab%init (size (p_real), 1)
	kinematics%p_born_lab%phs_point(1) = p_born
	kinematics%p_real_lab%phs_point(i_phs) = p_real
	end if
	end associate
	end subroutine pcm_nlo_workspace_set_momenta

	@ %def pcm_nlo_workspace_set_momenta
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: get_momenta => pcm_nlo_workspace_get_momenta
	<<PCM: sub interfaces>>=
	module function pcm_nlo_workspace_get_momenta (pcm_work, pcm, &
	i_phs, born_phsp, cms) result (p)
	type(vector4_t), dimension(:), allocatable :: p
	class(pcm_nlo_workspace_t), intent(in) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	integer, intent(in) :: i_phs
	logical, intent(in) :: born_phsp
	logical, intent(in), optional :: cms
	end function pcm_nlo_workspace_get_momenta
	<<PCM: procedures>>=
	module function pcm_nlo_workspace_get_momenta (pcm_work, pcm, &
	i_phs, born_phsp, cms) result (p)
	type(vector4_t), dimension(:), allocatable :: p
	class(pcm_nlo_workspace_t), intent(in) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	integer, intent(in) :: i_phs
	logical, intent(in) :: born_phsp
	logical, intent(in), optional :: cms
	logical :: yorn
	yorn = .false.; if (present (cms)) yorn = cms
	select type (pcm)
	type is (pcm_nlo_t)
	if (born_phsp) then
	if (yorn) then
	p = pcm_work%real_kinematics%p_born_cms%phs_point(1)
	else
	p = pcm_work%real_kinematics%p_born_lab%phs_point(1)
	end if
	else
	if (yorn) then
	p = pcm_work%real_kinematics%p_real_cms%phs_point(i_phs)
	else
	p = pcm_work%real_kinematics%p_real_lab%phs_point(i_phs)
	end if
	end if
	end select
	end function pcm_nlo_workspace_get_momenta

	@ %def pcm_nlo_workspace_get_momenta
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: get_xi_max => pcm_nlo_workspace_get_xi_max
	<<PCM: sub interfaces>>=
	module function pcm_nlo_workspace_get_xi_max (pcm_work, alr) result (xi_max)
	real(default) :: xi_max
	class(pcm_nlo_workspace_t), intent(in) :: pcm_work
	integer, intent(in) :: alr
	end function pcm_nlo_workspace_get_xi_max
	<<PCM: procedures>>=
	module function pcm_nlo_workspace_get_xi_max (pcm_work, alr) result (xi_max)
	real(default) :: xi_max
	class(pcm_nlo_workspace_t), intent(in) :: pcm_work
	integer, intent(in) :: alr
	integer :: i_phs
	i_phs = pcm_work%real_kinematics%alr_to_i_phs (alr)
	xi_max = pcm_work%real_kinematics%xi_max (i_phs)
	end function pcm_nlo_workspace_get_xi_max

	@ %def pcm_nlo_workspace_get_xi_max
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: set_x_rad => pcm_nlo_workspace_set_x_rad
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_set_x_rad (pcm_work, x_tot)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	real(default), intent(in), dimension(:) :: x_tot
	end subroutine pcm_nlo_workspace_set_x_rad
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_set_x_rad (pcm_work, x_tot)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	real(default), intent(in), dimension(:) :: x_tot
	integer :: n_par
	n_par = size (x_tot)
	if (n_par < 3) then
	pcm_work%real_kinematics%x_rad = zero
	else
	pcm_work%real_kinematics%x_rad = x_tot (n_par - 2 : n_par)
	end if
	end subroutine pcm_nlo_workspace_set_x_rad

	@ %def pcm_nlo_workspace_set_x_rad
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: init_virtual => pcm_nlo_workspace_init_virtual
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_init_virtual (pcm_work, pcm, model)
	class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
	class(pcm_t), intent(in) :: pcm
	class(model_data_t), intent(in) :: model
	end subroutine pcm_nlo_workspace_init_virtual
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_init_virtual (pcm_work, pcm, model)
	class(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
	class(pcm_t), intent(in) :: pcm
	class(model_data_t), intent(in) :: model
	select type (pcm)
	type is (pcm_nlo_t)
	associate (region_data => pcm%region_data)
	call pcm_work%virtual%init (region_data%get_flv_states_born (), &
	region_data%n_in, pcm%settings, model, pcm%has_pdfs)
	end associate
	end select
	end subroutine pcm_nlo_workspace_init_virtual

	@ %def pcm_nlo_workspace_init_virtual
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: disable_virtual_subtraction => &
	pcm_nlo_workspace_disable_virtual_subtraction
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_disable_virtual_subtraction (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	end subroutine pcm_nlo_workspace_disable_virtual_subtraction
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_disable_virtual_subtraction (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	end subroutine pcm_nlo_workspace_disable_virtual_subtraction

	@ %def pcm_nlo_workspace_disable_virtual_subtraction
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: compute_sqme_virt => pcm_nlo_workspace_compute_sqme_virt
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_compute_sqme_virt (pcm_work, pcm, p, &
	alpha_coupling, separate_uborns, sqme_virt)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), dimension(2), intent(in) :: alpha_coupling
	logical, intent(in) :: separate_uborns
	real(default), dimension(:), allocatable, intent(inout) :: sqme_virt
	end subroutine pcm_nlo_workspace_compute_sqme_virt
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_compute_sqme_virt (pcm_work, pcm, p, &
	alpha_coupling, separate_uborns, sqme_virt)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), dimension(2), intent(in) :: alpha_coupling
	logical, intent(in) :: separate_uborns
	real(default), dimension(:), allocatable, intent(inout) :: sqme_virt
	type(vector4_t), dimension(:), allocatable :: pp
	associate (virtual => pcm_work%virtual)
	allocate (pp (size (p)))
	if (virtual%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
	pp = pcm_work%real_kinematics%p_born_onshell%get_momenta (1)
	else
	pp = p
	end if
	select type (pcm)
	type is (pcm_nlo_t)
	if (separate_uborns) then
	allocate (sqme_virt (pcm%get_n_flv_born ()))
	else
	allocate (sqme_virt (1))
	end if
	sqme_virt = zero
	call virtual%evaluate (pcm%region_data, &
	alpha_coupling, pp, separate_uborns, sqme_virt)
	end select
	end associate
	end subroutine pcm_nlo_workspace_compute_sqme_virt

	@ %def pcm_nlo_workspace_compute_sqme_virt
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: compute_sqme_mismatch => pcm_nlo_workspace_compute_sqme_mismatch
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_compute_sqme_mismatch (pcm_work, pcm, &
	alpha_s, separate_uborns, sqme_mism)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	real(default), intent(in) :: alpha_s
	logical, intent(in) :: separate_uborns
	real(default), dimension(:), allocatable, intent(inout) :: sqme_mism
	end subroutine pcm_nlo_workspace_compute_sqme_mismatch
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_compute_sqme_mismatch (pcm_work, pcm, &
	alpha_s, separate_uborns, sqme_mism)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	real(default), intent(in) :: alpha_s
	logical, intent(in) :: separate_uborns
	real(default), dimension(:), allocatable, intent(inout) :: sqme_mism
	select type (pcm)
	type is (pcm_nlo_t)
	if (separate_uborns) then
	allocate (sqme_mism (pcm%get_n_flv_born ()))
	else
	allocate (sqme_mism (1))
	end if
	sqme_mism = zero
	sqme_mism = pcm_work%soft_mismatch%evaluate (alpha_s)
	end select
	end subroutine pcm_nlo_workspace_compute_sqme_mismatch

	@ %def pcm_nlo_workspace_compute_sqme_mismatch
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: compute_sqme_dglap_remnant => &
	pcm_nlo_workspace_compute_sqme_dglap_remnant
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_compute_sqme_dglap_remnant (pcm_work, &
	pcm, alpha_coupling, separate_uborns, sqme_dglap)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	real(default), dimension(2), intent(in) :: alpha_coupling
	logical, intent(in) :: separate_uborns
	real(default), dimension(:), allocatable, intent(inout) :: sqme_dglap
	end subroutine pcm_nlo_workspace_compute_sqme_dglap_remnant
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_compute_sqme_dglap_remnant (pcm_work, &
	pcm, alpha_coupling, separate_uborns, sqme_dglap)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	real(default), dimension(2), intent(in) :: alpha_coupling
	logical, intent(in) :: separate_uborns
	real(default), dimension(:), allocatable, intent(inout) :: sqme_dglap
	select type (pcm)
	type is (pcm_nlo_t)
	if (separate_uborns) then
	allocate (sqme_dglap (pcm%get_n_flv_born ()))
	else
	allocate (sqme_dglap (1))
	end if
	end select
	sqme_dglap = zero
	call pcm_work%dglap_remnant%evaluate (alpha_coupling, &
	separate_uborns, sqme_dglap)
	end subroutine pcm_nlo_workspace_compute_sqme_dglap_remnant

	@ %def pcm_nlo_workspace_compute_sqme_dglap_remnant
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: set_fixed_order_event_mode => &
	pcm_nlo_workspace_set_fixed_order_event_mode
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_set_fixed_order_event_mode (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	end subroutine pcm_nlo_workspace_set_fixed_order_event_mode
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_set_fixed_order_event_mode (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	pcm_work%real_sub%purpose = FIXED_ORDER_EVENTS
	end subroutine pcm_nlo_workspace_set_fixed_order_event_mode

	@ %def pcm_nlo_workspace_set_fixed_order_event_mode
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: init_soft_mismatch => pcm_nlo_workspace_init_soft_mismatch
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_init_soft_mismatch (pcm_work, pcm)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	end subroutine pcm_nlo_workspace_init_soft_mismatch
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_init_soft_mismatch (pcm_work, pcm)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	select type (pcm)
	type is (pcm_nlo_t)
	call pcm_work%soft_mismatch%init (pcm%region_data, &
	pcm_work%real_kinematics, pcm%settings%factorization_mode)
	end select
	end subroutine pcm_nlo_workspace_init_soft_mismatch

	@ %def pcm_nlo_workspace_init_soft_mismatch
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: init_dglap_remnant => pcm_nlo_workspace_init_dglap_remnant
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_init_dglap_remnant (pcm_work, pcm)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	end subroutine pcm_nlo_workspace_init_dglap_remnant
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_init_dglap_remnant (pcm_work, pcm)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	class(pcm_t), intent(in) :: pcm
	select type (pcm)
	type is (pcm_nlo_t)
	call pcm_work%dglap_remnant%init ( &
	pcm%settings, &
	pcm%region_data, &
	pcm_work%isr_kinematics)
	end select
	end subroutine pcm_nlo_workspace_init_dglap_remnant

	@ %def pcm_nlo_workspace_init_dglap_remnant
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: is_fixed_order_nlo_events &
	=> pcm_nlo_workspace_is_fixed_order_nlo_events
	<<PCM: sub interfaces>>=
	module function pcm_nlo_workspace_is_fixed_order_nlo_events &
	(pcm_work) result (is_fnlo)
	logical :: is_fnlo
	class(pcm_nlo_workspace_t), intent(in) :: pcm_work
	end function pcm_nlo_workspace_is_fixed_order_nlo_events
	<<PCM: procedures>>=
	module function pcm_nlo_workspace_is_fixed_order_nlo_events &
	(pcm_work) result (is_fnlo)
	logical :: is_fnlo
	class(pcm_nlo_workspace_t), intent(in) :: pcm_work
	is_fnlo = pcm_work%real_sub%purpose == FIXED_ORDER_EVENTS
	end function pcm_nlo_workspace_is_fixed_order_nlo_events

	@ %def pcm_nlo_workspace_is_fixed_order_nlo_events
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: final => pcm_nlo_workspace_final
	<<PCM: sub interfaces>>=
	module subroutine pcm_nlo_workspace_final (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	end subroutine pcm_nlo_workspace_final
	<<PCM: procedures>>=
	module subroutine pcm_nlo_workspace_final (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	call pcm_work%real_sub%final ()
	call pcm_work%virtual%final ()
	call pcm_work%soft_mismatch%final ()
	call pcm_work%dglap_remnant%final ()
	if (associated (pcm_work%real_kinematics)) then
	call pcm_work%real_kinematics%final ()
	nullify (pcm_work%real_kinematics)
	end if
	if (associated (pcm_work%isr_kinematics)) then
	nullify (pcm_work%isr_kinematics)
	end if
	end subroutine pcm_nlo_workspace_final

	@ %def pcm_nlo_workspace_final
	@
	<<PCM: pcm instance: TBP>>=
	procedure :: is_nlo => pcm_nlo_workspace_is_nlo
	<<PCM: sub interfaces>>=
	module function pcm_nlo_workspace_is_nlo (pcm_work) result (is_nlo)
	logical :: is_nlo
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	end function pcm_nlo_workspace_is_nlo
	<<PCM: procedures>>=
	module function pcm_nlo_workspace_is_nlo (pcm_work) result (is_nlo)
	logical :: is_nlo
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	is_nlo = .true.
	end function pcm_nlo_workspace_is_nlo

	@ %def pcm_nlo_workspace_is_nlo
	@ This routine modifies the kinematic factors applied to the real matrix element
	for use with POWHEG matching. We need to divide the real matrix element by [[xi_max]] to
	cancel a factor of [[xi_max]] applied in [[apply_kinematic_factors_radiation]].
	It comes from the fact that we sample $\tilde\xi \in [0,1]$ when integrating
	but $\xi \in [p_T^2,\xi_\text{max}]$ for POWHEG matching.
	Thus, we are taking into account that $d\xi = d\tilde\xi
	\frac{\xi}{\tilde\xi} = d\tilde\xi \xi_\text{max}$.
	Additionally, we need to cancel the Jacobian from the random number mapping.
	We only want the physical part of the Jacobian in our Sudakov splitting function.
	Furthermore, the real matrix element lacks its flux factor
	$\frac{1}{2 \hat s_{\mathcal{R}}}$ and the real Jacobian lacks a factor of
	$\frac{1}{1-\xi}$. Together, this is a factor of $\frac{1}{2 \hat s_{\mathcal{B}}}$,
	i.e. the same as the flux factor of the Born matrix element. We do not correct
	any of both here, as only the ratio of both will be relevant for the Sudakov.
	<<PCM: pcm instance: TBP>>=
	procedure :: powheg_kinematic_factors_real => &
	pcm_nlo_workspace_powheg_kinematic_factors_real
	<<PCM: sub interfaces>>=
	module function pcm_nlo_workspace_powheg_kinematic_factors_real &
	(pcm_work, sqme_real, alr) result (sqme_real_corr)
	real(default) :: sqme_real_corr
	class(pcm_nlo_workspace_t), intent(in) :: pcm_work
	real(default), intent(in) :: sqme_real
	integer, intent(in) :: alr
	end function pcm_nlo_workspace_powheg_kinematic_factors_real
	<<PCM: procedures>>=
	module function pcm_nlo_workspace_powheg_kinematic_factors_real &
	(pcm_work, sqme_real, alr) result (sqme_real_corr)
	real(default) :: sqme_real_corr
	class(pcm_nlo_workspace_t), intent(in) :: pcm_work
	real(default), intent(in) :: sqme_real
	integer, intent(in) :: alr
	real(default) :: xi_max, jac_rand
	integer :: i_phs
	xi_max = pcm_work%get_xi_max (alr)
	i_phs = pcm_work%real_kinematics%alr_to_i_phs (alr)
	jac_rand = pcm_work%real_kinematics%jac_rand (i_phs)
	sqme_real_corr = sqme_real / xi_max / jac_rand
	end function pcm_nlo_workspace_powheg_kinematic_factors_real

	@ %def pcm_nlo_workspace_powheg_kinematic_factors_real
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Kinematics instance}
	In this data type we combine all objects (instances) necessary for
	generating (or recovering) a kinematical configuration. The
	components work together as an implementation of multi-channel phase
	space.

	[[sf_chain]] is an instance of the structure-function chain. It is
	used both for generating kinematics and, after the proper scale has
	been determined, evaluating the structure function entries.

	[[phs]] is an instance of the phase space for the elementary process.

	The array [[f]] contains the products of the Jacobians that originate
	from parameter mappings in the structure-function chain or in the
	phase space. We allocate this explicitly if either [[sf_chain]] or
	[[phs]] are explicitly allocated, otherwise we can take over a pointer.

	All components are implemented as pointers to (anonymous) targets.
	For each component, there is a flag that tells whether this component
	is to be regarded as a proper component (`owned' by the object) or as
	a pointer.
	@
	<<[[kinematics.f90]]>>=
	<<File header>>

	module kinematics

	<<Use kinds>>
	use lorentz
	use physics_defs
	use sf_base
	use phs_base
	use fks_regions
	use mci_base
	use process_config
	use process_mci
	use pcm_base, only: pcm_t, pcm_workspace_t
	use pcm, only: pcm_nlo_t, pcm_nlo_workspace_t

	<<Standard module head>>

	<<Kinematics: public>>

	<<Kinematics: types>>

	interface
	<<Kinematics: sub interfaces>>
	end interface

	end module kinematics
	@ %def kinematics
	@
	<<[[kinematics_sub.f90]]>>=
	<<File header>>

	submodule (kinematics) kinematics_s

	<<Use debug>>
	use format_utils, only: write_separator
	use diagnostics
	use io_units
	use phs_points, only: assignment(=), size
	use interactions
	use phs_fks
	use ttv_formfactors, only: m1s_to_mpole

	implicit none

	contains

	<<Kinematics: procedures>>

	end submodule kinematics_s

	@ %def kinematics_s
	@
	<<Kinematics: public>>=
	public :: kinematics_t
	<<Kinematics: types>>=
	type :: kinematics_t
	integer :: n_in = 0
	integer :: n_channel = 0
	integer :: selected_channel = 0
	type(sf_chain_instance_t), pointer :: sf_chain => null ()
	class(phs_t), pointer :: phs => null ()
	real(default), dimension(:), pointer :: f => null ()
	real(default) :: phs_factor
	logical :: sf_chain_allocated = .false.
	logical :: phs_allocated = .false.
	logical :: f_allocated = .false.
	integer :: emitter = -1
	integer :: i_phs = 0
	integer :: i_con = 0
	logical :: only_cm_frame = .false.
	logical :: new_seed = .true.
	logical :: threshold = .false.
	contains
	<<Kinematics: kinematics: TBP>>
	end type kinematics_t

	@ %def kinematics_t
	@ Output. Show only those components which are marked as owned.
	<<Kinematics: kinematics: TBP>>=
	procedure :: write => kinematics_write
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_write (object, unit)
	class(kinematics_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine kinematics_write
	<<Kinematics: procedures>>=
	module subroutine kinematics_write (object, unit)
	class(kinematics_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, c
	u = given_output_unit (unit)
	if (object%f_allocated) then
	write (u, "(1x,A)") "Flux * PHS volume:"
	write (u, "(2x,ES19.12)") object%phs_factor
	write (u, "(1x,A)") "Jacobian factors per channel:"
	do c = 1, size (object%f)
	write (u, "(3x,I0,':',1x,ES14.7)", advance="no") c, object%f(c)
	if (c == object%selected_channel) then
	write (u, "(1x,A)") "[selected]"
	else
	write (u, *)
	end if
	end do
	end if
	if (object%sf_chain_allocated) then
	call write_separator (u)
	call object%sf_chain%write (u)
	end if
	if (object%phs_allocated) then
	call write_separator (u)
	call object%phs%write (u)
	end if
	end subroutine kinematics_write

	@ %def kinematics_write
	@ Finalizer. Delete only those components which are marked as owned.
	<<Kinematics: kinematics: TBP>>=
	procedure :: final => kinematics_final
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_final (object)
	class(kinematics_t), intent(inout) :: object
	end subroutine kinematics_final
	<<Kinematics: procedures>>=
	module subroutine kinematics_final (object)
	class(kinematics_t), intent(inout) :: object
	if (object%sf_chain_allocated) then
	call object%sf_chain%final ()
	deallocate (object%sf_chain)
	object%sf_chain_allocated = .false.
	end if
	if (object%phs_allocated) then
	call object%phs%final ()
	deallocate (object%phs)
	object%phs_allocated = .false.
	end if
	if (object%f_allocated) then
	deallocate (object%f)
	object%f_allocated = .false.
	end if
	end subroutine kinematics_final

	@ %def kinematics_final
	@ Configure the kinematics object. This consists of several
	configuration steps which correspond to individual procedures. In
	essence, we configure the structure-function part, the partonic
	phase-space part, and various NLO items.

	TODO wk 19-03-01: This includes some region-data setup within [[pcm]],
	hence [[pcm]] is intent(inout). This should be moved elsewhere, so
	[[pcm]] can become strictly intent(in).
	<<Kinematics: kinematics: TBP>>=
	procedure :: configure => kinematics_configure
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_configure (kin, pcm, pcm_work, &
	sf_chain, beam_config, phs_config, nlo_type, is_i_sub)
	class(kinematics_t), intent(out) :: kin
	class(pcm_t), intent(inout) :: pcm
	class(pcm_workspace_t), intent(in) :: pcm_work
	type(sf_chain_t), intent(in), target :: sf_chain
	type(process_beam_config_t), intent(in), target :: beam_config
	class(phs_config_t), intent(in), target :: phs_config
	integer, intent(in) :: nlo_type
	logical, intent(in) :: is_i_sub
	end subroutine kinematics_configure
	<<Kinematics: procedures>>=
	module subroutine kinematics_configure (kin, pcm, pcm_work, &
	sf_chain, beam_config, phs_config, nlo_type, is_i_sub)
	class(kinematics_t), intent(out) :: kin
	class(pcm_t), intent(inout) :: pcm
	class(pcm_workspace_t), intent(in) :: pcm_work
	type(sf_chain_t), intent(in), target :: sf_chain
	type(process_beam_config_t), intent(in), target :: beam_config
	class(phs_config_t), intent(in), target :: phs_config
	integer, intent(in) :: nlo_type
	logical, intent(in) :: is_i_sub
	logical :: extended_sf
	extended_sf = nlo_type == NLO_DGLAP .or. &
	(nlo_type == NLO_REAL .and. is_i_sub)
	call kin%init_sf_chain (sf_chain, beam_config, &
	extended_sf = pcm%has_pdfs .and. extended_sf)
	!!! Add one for additional Born matrix element
	call kin%init_phs (phs_config)
	call kin%set_nlo_info (nlo_type)
	select type (phs => kin%phs)
	type is (phs_fks_t)
	call phs%allocate_momenta (phs_config, .not. (nlo_type == NLO_REAL))
	select type (pcm)
	type is (pcm_nlo_t)
	call pcm%region_data%init_phs_identifiers (phs%phs_identifiers)
	!!! The triple select type pyramid of doom
	select type (pcm_work)
	type is (pcm_nlo_workspace_t)
	if (allocated (pcm_work%real_kinematics%alr_to_i_phs)) &
	call pcm%region_data%set_alr_to_i_phs (phs%phs_identifiers, &
	pcm_work%real_kinematics%alr_to_i_phs)
	end select
	end select
	end select
	end subroutine kinematics_configure

	@ %def kinematics_configure
	@ Set the flags indicating whether the phase space shall be set up for the calculation of the real contribution. For this case, also set the emitter.
	<<Kinematics: kinematics: TBP>>=
	procedure :: set_nlo_info => kinematics_set_nlo_info
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_set_nlo_info (k, nlo_type)
	class(kinematics_t), intent(inout) :: k
	integer, intent(in) :: nlo_type
	end subroutine kinematics_set_nlo_info
	<<Kinematics: procedures>>=
	module subroutine kinematics_set_nlo_info (k, nlo_type)
	class(kinematics_t), intent(inout) :: k
	integer, intent(in) :: nlo_type
	if (nlo_type == NLO_VIRTUAL) k%only_cm_frame = .true.
	end subroutine kinematics_set_nlo_info

	@ %def kinematics_set_nlo_info
	@
	<<Kinematics: kinematics: TBP>>=
	procedure :: set_threshold => kinematics_set_threshold
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_set_threshold (kin, factorization_mode)
	class(kinematics_t), intent(inout) :: kin
	integer, intent(in) :: factorization_mode
	end subroutine kinematics_set_threshold
	<<Kinematics: procedures>>=
	module subroutine kinematics_set_threshold (kin, factorization_mode)
	class(kinematics_t), intent(inout) :: kin
	integer, intent(in) :: factorization_mode
	kin%threshold = factorization_mode == FACTORIZATION_THRESHOLD
	end subroutine kinematics_set_threshold

	@ %def kinematics_set_threshold
	@ Allocate the structure-function chain instance, initialize it as a
	copy of the [[sf_chain]] template, and prepare it for evaluation.

	The [[sf_chain]] remains a target because the (usually constant) beam momenta
	are taken from there.
	<<Kinematics: kinematics: TBP>>=
	procedure :: init_sf_chain => kinematics_init_sf_chain
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_init_sf_chain &
	(k, sf_chain, config, extended_sf)
	class(kinematics_t), intent(inout) :: k
	type(sf_chain_t), intent(in), target :: sf_chain
	type(process_beam_config_t), intent(in) :: config
	logical, intent(in), optional :: extended_sf
	end subroutine kinematics_init_sf_chain
	<<Kinematics: procedures>>=
	module subroutine kinematics_init_sf_chain (k, sf_chain, config, extended_sf)
	class(kinematics_t), intent(inout) :: k
	type(sf_chain_t), intent(in), target :: sf_chain
	type(process_beam_config_t), intent(in) :: config
	logical, intent(in), optional :: extended_sf
	integer :: n_strfun, n_channel
	integer :: c
	k%n_in = config%data%get_n_in ()
	n_strfun = config%n_strfun
	n_channel = config%n_channel
	allocate (k%sf_chain)
	k%sf_chain_allocated = .true.
	call k%sf_chain%init (sf_chain, n_channel)
	if (n_strfun /= 0) then
	do c = 1, n_channel
	call k%sf_chain%set_channel (c, config%sf_channel(c))
	end do
	end if
	call k%sf_chain%link_interactions ()
	call k%sf_chain%exchange_mask ()
	call k%sf_chain%init_evaluators (extended_sf = extended_sf)
	end subroutine kinematics_init_sf_chain

	@ %def kinematics_init_sf_chain
	@ Allocate and initialize the phase-space part and the array of
	Jacobian factors.
	<<Kinematics: kinematics: TBP>>=
	procedure :: init_phs => kinematics_init_phs
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_init_phs (k, config)
	class(kinematics_t), intent(inout) :: k
	class(phs_config_t), intent(in), target :: config
	end subroutine kinematics_init_phs
	<<Kinematics: procedures>>=
	module subroutine kinematics_init_phs (k, config)
	class(kinematics_t), intent(inout) :: k
	class(phs_config_t), intent(in), target :: config
	k%n_channel = config%get_n_channel ()
	call config%allocate_instance (k%phs)
	call k%phs%init (config)
	k%phs_allocated = .true.
	allocate (k%f (k%n_channel))
	k%f = 0
	k%f_allocated = .true.
	end subroutine kinematics_init_phs

	@ %def kinematics_init_phs
	@
	<<Kinematics: kinematics: TBP>>=
	procedure :: evaluate_radiation_kinematics => &
	kinematics_evaluate_radiation_kinematics
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_evaluate_radiation_kinematics (k, r_in)
	class(kinematics_t), intent(inout) :: k
	real(default), intent(in), dimension(:) :: r_in
	end subroutine kinematics_evaluate_radiation_kinematics
	<<Kinematics: procedures>>=
	module subroutine kinematics_evaluate_radiation_kinematics (k, r_in)
	class(kinematics_t), intent(inout) :: k
	real(default), intent(in), dimension(:) :: r_in
	select type (phs => k%phs)
	type is (phs_fks_t)
	if (phs%mode == PHS_MODE_ADDITIONAL_PARTICLE) then
	call phs%generate_radiation_variables &
	(r_in(phs%n_r_born + 1 : phs%n_r_born + 3), &
	threshold = k%threshold)
	call phs%compute_cms_energy ()
	end if
	end select
	end subroutine kinematics_evaluate_radiation_kinematics

	@ %def kinematics_evaluate_radiation_kinematics
	@
	<<Kinematics: kinematics: TBP>>=
	procedure :: generate_fsr_in => kinematics_generate_fsr_in
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_generate_fsr_in (kin)
	class(kinematics_t), intent(inout) :: kin
	end subroutine kinematics_generate_fsr_in
	<<Kinematics: procedures>>=
	module subroutine kinematics_generate_fsr_in (kin)
	class(kinematics_t), intent(inout) :: kin
	select type (phs => kin%phs)
	type is (phs_fks_t)
	call phs%generate_fsr_in ()
	end select
	end subroutine kinematics_generate_fsr_in

	@ %def kinematics_generate_fsr_in
	@
	<<Kinematics: kinematics: TBP>>=
	procedure :: compute_xi_ref_momenta => kinematics_compute_xi_ref_momenta
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_compute_xi_ref_momenta (k, reg_data, nlo_type)
	class(kinematics_t), intent(inout) :: k
	type(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: nlo_type
	end subroutine kinematics_compute_xi_ref_momenta
	<<Kinematics: procedures>>=
	module subroutine kinematics_compute_xi_ref_momenta (k, reg_data, nlo_type)
	class(kinematics_t), intent(inout) :: k
	type(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: nlo_type
	logical :: use_contributors
	use_contributors = allocated (reg_data%alr_contributors)
	select type (phs => k%phs)
	type is (phs_fks_t)
	if (use_contributors) then
	call phs%compute_xi_ref_momenta (contributors = reg_data%alr_contributors)
	else if (k%threshold) then
	if (.not. is_subtraction_component (k%emitter, nlo_type)) &
	call phs%compute_xi_ref_momenta_threshold ()
	else
	call phs%compute_xi_ref_momenta ()
	end if
	end select
	end subroutine kinematics_compute_xi_ref_momenta

	@ %def kinematics_compute_xi_ref_momenta
	@ Generate kinematics, given a phase-space channel and a MC
	parameter set. The main result is the momentum array [[p]], but we
	also fill the momentum entries in the structure-function chain and the
	Jacobian-factor array [[f]]. Regarding phase space, we fill only the
	parameter arrays for the selected channel.
	<<Kinematics: kinematics: TBP>>=
	procedure :: compute_selected_channel => kinematics_compute_selected_channel
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_compute_selected_channel &
	(k, mci_work, phs_channel, p, success)
	class(kinematics_t), intent(inout) :: k
	type(mci_work_t), intent(in) :: mci_work
	integer, intent(in) :: phs_channel
	type(vector4_t), dimension(:), intent(out) :: p
	logical, intent(out) :: success
	end subroutine kinematics_compute_selected_channel
	<<Kinematics: procedures>>=
	module subroutine kinematics_compute_selected_channel &
	(k, mci_work, phs_channel, p, success)
	class(kinematics_t), intent(inout) :: k
	type(mci_work_t), intent(in) :: mci_work
	integer, intent(in) :: phs_channel
	type(vector4_t), dimension(:), intent(out) :: p
	logical, intent(out) :: success
	integer :: sf_channel
	k%selected_channel = phs_channel
	sf_channel = k%phs%config%get_sf_channel (phs_channel)
	call k%sf_chain%compute_kinematics (sf_channel, mci_work%get_x_strfun ())
	call k%sf_chain%get_out_momenta (p(1:k%n_in))
	call k%phs%set_incoming_momenta (p(1:k%n_in))
	call k%phs%compute_flux ()
	call k%phs%select_channel (phs_channel)
	call k%phs%evaluate_selected_channel (phs_channel, &
	mci_work%get_x_process ())

	select type (phs => k%phs)
	type is (phs_fks_t)
	if (debug_on) call msg_debug2 (D_REAL, "phase space is phs_FKS")
	if (phs%q_defined) then
	call phs%get_born_momenta (p)
	if (debug_on) then
	call msg_debug2 (D_REAL, "q is defined")
	call msg_debug2 (D_REAL, "get_born_momenta called")
	end if
	k%phs_factor = phs%get_overall_factor ()
	success = .true.
	else
	k%phs_factor = 0
	success = .false.
	end if
	class default
	if (phs%q_defined) then
	call k%phs%get_outgoing_momenta (p(k%n_in + 1 :))
	k%phs_factor = k%phs%get_overall_factor ()
	success = .true.
	else
	k%phs_factor = 0
	success = .false.
	end if
	end select
	end subroutine kinematics_compute_selected_channel

	@ %def kinematics_compute_selected_channel
	@
	<<Kinematics: kinematics: TBP>>=
	procedure :: redo_sf_chain => kinematics_redo_sf_chain
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_redo_sf_chain (kin, mci_work, phs_channel)
	class(kinematics_t), intent(inout) :: kin
	type(mci_work_t), intent(in) :: mci_work
	integer, intent(in) :: phs_channel
	end subroutine kinematics_redo_sf_chain
	<<Kinematics: procedures>>=
	module subroutine kinematics_redo_sf_chain (kin, mci_work, phs_channel)
	class(kinematics_t), intent(inout) :: kin
	type(mci_work_t), intent(in) :: mci_work
	integer, intent(in) :: phs_channel
	real(default), dimension(:), allocatable :: x
	integer :: sf_channel, n
	real(default) :: xi, y
	n = size (mci_work%get_x_strfun ())
	if (n > 0) then
	allocate (x(n))
	x = mci_work%get_x_strfun ()
	sf_channel = kin%phs%config%get_sf_channel (phs_channel)
	call kin%sf_chain%compute_kinematics (sf_channel, x)
	end if
	end subroutine kinematics_redo_sf_chain

	@ %def kinematics_redo_sf_chain
	@ Complete kinematics by filling the non-selected phase-space parameter
	arrays.
	<<Kinematics: kinematics: TBP>>=
	procedure :: compute_other_channels => kinematics_compute_other_channels
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_compute_other_channels &
	(k, mci_work, phs_channel)
	class(kinematics_t), intent(inout) :: k
	type(mci_work_t), intent(in) :: mci_work
	integer, intent(in) :: phs_channel
	end subroutine kinematics_compute_other_channels
	<<Kinematics: procedures>>=
	module subroutine kinematics_compute_other_channels (k, mci_work, phs_channel)
	class(kinematics_t), intent(inout) :: k
	type(mci_work_t), intent(in) :: mci_work
	integer, intent(in) :: phs_channel
	integer :: c, c_sf
	call k%phs%evaluate_other_channels (phs_channel)
	do c = 1, k%n_channel
	c_sf = k%phs%config%get_sf_channel (c)
	k%f(c) = k%sf_chain%get_f (c_sf) * k%phs%get_f (c)
	end do
	end subroutine kinematics_compute_other_channels

	@ %def kinematics_compute_other_channels
	@ Just fetch the outgoing momenta of the [[sf_chain]] subobject, which
	become the incoming (seed) momenta of the hard interaction.

	This is a stripped down-version of the above which we use when
	recovering kinematics. Momenta are known, but no MC parameters yet.

	(We do not use the [[get_out_momenta]] method of the chain, since this
	relies on the structure-function interactions, which are not necessary
	filled here. We do rely on the momenta of the last evaluator in the
	chain, however.)
	<<Kinematics: kinematics: TBP>>=
	procedure :: get_incoming_momenta => kinematics_get_incoming_momenta
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_get_incoming_momenta (k, p)
	class(kinematics_t), intent(in) :: k
	type(vector4_t), dimension(:), intent(out) :: p
	end subroutine kinematics_get_incoming_momenta
	<<Kinematics: procedures>>=
	module subroutine kinematics_get_incoming_momenta (k, p)
	class(kinematics_t), intent(in) :: k
	type(vector4_t), dimension(:), intent(out) :: p
	type(interaction_t), pointer :: int
	integer :: i
	int => k%sf_chain%get_out_int_ptr ()
	do i = 1, k%n_in
	p(i) = int%get_momentum (k%sf_chain%get_out_i (i))
	end do
	end subroutine kinematics_get_incoming_momenta

	@ %def kinematics_get_incoming_momenta
	@
	<<Kinematics: kinematics: TBP>>=
	procedure :: get_boost_to_lab => kinematics_get_boost_to_lab
	<<Kinematics: sub interfaces>>=
	module function kinematics_get_boost_to_lab (kin) result (lt)
	type(lorentz_transformation_t) :: lt
	class(kinematics_t), intent(in) :: kin
	end function kinematics_get_boost_to_lab
	<<Kinematics: procedures>>=
	module function kinematics_get_boost_to_lab (kin) result (lt)
	type(lorentz_transformation_t) :: lt
	class(kinematics_t), intent(in) :: kin
	lt = kin%phs%get_lorentz_transformation ()
	end function kinematics_get_boost_to_lab

	@ %def kinematics_get_boost_to_lab
	@
	<<Kinematics: kinematics: TBP>>=
	procedure :: get_boost_to_cms => kinematics_get_boost_to_cms
	<<Kinematics: sub interfaces>>=
	module function kinematics_get_boost_to_cms (kin) result (lt)
	type(lorentz_transformation_t) :: lt
	class(kinematics_t), intent(in) :: kin
	end function kinematics_get_boost_to_cms
	<<Kinematics: procedures>>=
	module function kinematics_get_boost_to_cms (kin) result (lt)
	type(lorentz_transformation_t) :: lt
	class(kinematics_t), intent(in) :: kin
	lt = inverse (kin%phs%get_lorentz_transformation ())
	end function kinematics_get_boost_to_cms

	@ %def kinematics_get_boost_to_cms
	@ This inverts the remainder of the above [[compute]] method. We know
	the momenta and recover the rest, as far as needed. If we select a
	channel, we can complete the inversion and reconstruct the
	MC parameter set.
	<<Kinematics: kinematics: TBP>>=
	procedure :: recover_mcpar => kinematics_recover_mcpar
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_recover_mcpar (k, mci_work, phs_channel, p)
	class(kinematics_t), intent(inout) :: k
	type(mci_work_t), intent(inout) :: mci_work
	integer, intent(in) :: phs_channel
	type(vector4_t), dimension(:), intent(in) :: p
	end subroutine kinematics_recover_mcpar
	<<Kinematics: procedures>>=
	module subroutine kinematics_recover_mcpar (k, mci_work, phs_channel, p)
	class(kinematics_t), intent(inout) :: k
	type(mci_work_t), intent(inout) :: mci_work
	integer, intent(in) :: phs_channel
	type(vector4_t), dimension(:), intent(in) :: p
	integer :: c, c_sf
	real(default), dimension(:), allocatable :: x_sf, x_phs
	c = phs_channel
	c_sf = k%phs%config%get_sf_channel (c)
	k%selected_channel = c
	call k%sf_chain%recover_kinematics (c_sf)
	call k%phs%set_incoming_momenta (p(1:k%n_in))
	call k%phs%compute_flux ()
	call k%phs%set_outgoing_momenta (p(k%n_in+1:))
	call k%phs%inverse ()
	do c = 1, k%n_channel
	c_sf = k%phs%config%get_sf_channel (c)
	k%f(c) = k%sf_chain%get_f (c_sf) * k%phs%get_f (c)
	end do
	k%phs_factor = k%phs%get_overall_factor ()
	c = phs_channel
	c_sf = k%phs%config%get_sf_channel (c)
	allocate (x_sf (k%sf_chain%config%get_n_bound ()))
	allocate (x_phs (k%phs%config%get_n_par ()))
	call k%phs%select_channel (c)
	call k%sf_chain%get_mcpar (c_sf, x_sf)
	call k%phs%get_mcpar (c, x_phs)
	call mci_work%set_x_strfun (x_sf)
	call mci_work%set_x_process (x_phs)
	end subroutine kinematics_recover_mcpar

	@ %def kinematics_recover_mcpar
	@ This first part of [[recover_mcpar]]: just handle the sfchain.
	<<Kinematics: kinematics: TBP>>=
	procedure :: recover_sfchain => kinematics_recover_sfchain
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_recover_sfchain (k, channel, p)
	class(kinematics_t), intent(inout) :: k
	integer, intent(in) :: channel
	type(vector4_t), dimension(:), intent(in) :: p
	end subroutine kinematics_recover_sfchain
	<<Kinematics: procedures>>=
	module subroutine kinematics_recover_sfchain (k, channel, p)
	class(kinematics_t), intent(inout) :: k
	integer, intent(in) :: channel
	type(vector4_t), dimension(:), intent(in) :: p
	k%selected_channel = channel
	call k%sf_chain%recover_kinematics (channel)
	end subroutine kinematics_recover_sfchain

	@ %def kinematics_recover_sfchain
	@ Retrieve the MC input parameter array for a specific channel. We assume
	that the kinematics is complete, so this is known for all channels.
	<<Kinematics: kinematics: TBP>>=
	procedure :: get_mcpar => kinematics_get_mcpar
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_get_mcpar (k, phs_channel, r)
	class(kinematics_t), intent(in) :: k
	integer, intent(in) :: phs_channel
	real(default), dimension(:), intent(out) :: r
	end subroutine kinematics_get_mcpar
	<<Kinematics: procedures>>=
	module subroutine kinematics_get_mcpar (k, phs_channel, r)
	class(kinematics_t), intent(in) :: k
	integer, intent(in) :: phs_channel
	real(default), dimension(:), intent(out) :: r
	integer :: sf_channel, n_par_sf, n_par_phs
	sf_channel = k%phs%config%get_sf_channel (phs_channel)
	n_par_phs = k%phs%config%get_n_par ()
	n_par_sf = k%sf_chain%config%get_n_bound ()
	if (n_par_sf > 0) then
	call k%sf_chain%get_mcpar (sf_channel, r(1:n_par_sf))
	end if
	if (n_par_phs > 0) then
	call k%phs%get_mcpar (phs_channel, r(n_par_sf+1:))
	end if
	end subroutine kinematics_get_mcpar

	@ %def kinematics_get_mcpar
	@ Evaluate the structure function chain, assuming that kinematics is known.

	The status must be precisely [[SF_DONE_KINEMATICS]]. We thus avoid
	evaluating the chain twice via different pointers to the same target.
	<<Kinematics: kinematics: TBP>>=
	procedure :: evaluate_sf_chain => kinematics_evaluate_sf_chain
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_evaluate_sf_chain &
	(k, fac_scale, negative_sf, sf_rescale)
	class(kinematics_t), intent(inout) :: k
	real(default), intent(in) :: fac_scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(inout), optional :: sf_rescale
	end subroutine kinematics_evaluate_sf_chain
	<<Kinematics: procedures>>=
	module subroutine kinematics_evaluate_sf_chain &
	(k, fac_scale, negative_sf, sf_rescale)
	class(kinematics_t), intent(inout) :: k
	real(default), intent(in) :: fac_scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(inout), optional :: sf_rescale
	select case (k%sf_chain%get_status ())
	case (SF_DONE_KINEMATICS)
	call k%sf_chain%evaluate (fac_scale, negative_sf = negative_sf, &
	sf_rescale = sf_rescale)
	end select
	end subroutine kinematics_evaluate_sf_chain

	@ %def kinematics_evaluate_sf_chain
	@ Recover beam momenta, i.e., return the beam momenta stored in the
	current [[sf_chain]] to their source. This is a side effect.
	<<Kinematics: kinematics: TBP>>=
	procedure :: return_beam_momenta => kinematics_return_beam_momenta
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_return_beam_momenta (k)
	class(kinematics_t), intent(in) :: k
	end subroutine kinematics_return_beam_momenta
	<<Kinematics: procedures>>=
	module subroutine kinematics_return_beam_momenta (k)
	class(kinematics_t), intent(in) :: k
	call k%sf_chain%return_beam_momenta ()
	end subroutine kinematics_return_beam_momenta

	@ %def kinematics_return_beam_momenta
	@ Check wether the phase space is configured in the center-of-mass frame.
	Relevant for using the proper momenta input for BLHA matrix elements.
	<<Kinematics: kinematics: TBP>>=
	procedure :: lab_is_cm => kinematics_lab_is_cm
	<<Kinematics: sub interfaces>>=
	module function kinematics_lab_is_cm (k) result (lab_is_cm)
	logical :: lab_is_cm
	class(kinematics_t), intent(in) :: k
	end function kinematics_lab_is_cm
	<<Kinematics: procedures>>=
	module function kinematics_lab_is_cm (k) result (lab_is_cm)
	logical :: lab_is_cm
	class(kinematics_t), intent(in) :: k
	lab_is_cm = k%phs%config%lab_is_cm
	end function kinematics_lab_is_cm

	@ %def kinematics_lab_is_cm
	@
	<<Kinematics: kinematics: TBP>>=
	procedure :: modify_momenta_for_subtraction => &
	kinematics_modify_momenta_for_subtraction
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_modify_momenta_for_subtraction (k, p_in, p_out)
	class(kinematics_t), intent(inout) :: k
	type(vector4_t), intent(in), dimension(:) :: p_in
	type(vector4_t), intent(out), dimension(:), allocatable :: p_out
	end subroutine kinematics_modify_momenta_for_subtraction
	<<Kinematics: procedures>>=
	module subroutine kinematics_modify_momenta_for_subtraction (k, p_in, p_out)
	class(kinematics_t), intent(inout) :: k
	type(vector4_t), intent(in), dimension(:) :: p_in
	type(vector4_t), intent(out), dimension(:), allocatable :: p_out
	allocate (p_out (size (p_in)))
	if (k%threshold) then
	select type (phs => k%phs)
	type is (phs_fks_t)
	p_out = phs%get_onshell_projected_momenta ()
	end select
	else
	p_out = p_in
	end if
	end subroutine kinematics_modify_momenta_for_subtraction

	@ %def kinematics_modify_momenta_for_subtraction
	@
	<<Kinematics: kinematics: TBP>>=
	procedure :: threshold_projection => kinematics_threshold_projection
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_threshold_projection (k, pcm_work, nlo_type)
	class(kinematics_t), intent(inout) :: k
	type(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	integer, intent(in) :: nlo_type
	end subroutine kinematics_threshold_projection
	<<Kinematics: procedures>>=
	module subroutine kinematics_threshold_projection (k, pcm_work, nlo_type)
	class(kinematics_t), intent(inout) :: k
	type(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	integer, intent(in) :: nlo_type
	real(default) :: sqrts, mtop
	type(lorentz_transformation_t) :: L_to_cms
	type(vector4_t), dimension(:), allocatable :: p_tot, p_onshell
	integer :: n_tot
	n_tot = k%phs%get_n_tot ()
	allocate (p_tot (size (pcm_work%real_kinematics%p_born_cms%phs_point(1))))
	select type (phs => k%phs)
	type is (phs_fks_t)
	p_tot = pcm_work%real_kinematics%p_born_cms%phs_point(1)
	class default
	p_tot(1 : k%n_in) = phs%p
	p_tot(k%n_in + 1 : n_tot) = phs%q
	end select
	sqrts = sum (p_tot (1:k%n_in))**1
	mtop = m1s_to_mpole (sqrts)
	L_to_cms = get_boost_for_threshold_projection (p_tot, sqrts, mtop)
	call pcm_work%real_kinematics%p_born_cms%set_momenta (1, p_tot)
	p_onshell = pcm_work%real_kinematics%p_born_onshell%phs_point(1)
	call threshold_projection_born (mtop, L_to_cms, p_tot, p_onshell)
	pcm_work%real_kinematics%p_born_onshell%phs_point(1) = p_onshell
	if (debug2_active (D_THRESHOLD)) then
	print *, 'On-shell projected Born: '
	call vector4_write_set (p_onshell)
	end if
	end subroutine kinematics_threshold_projection

	@ %def kinematics_threshold_projection
	@
	<<Kinematics: kinematics: TBP>>=
	procedure :: evaluate_radiation => kinematics_evaluate_radiation
	<<Kinematics: sub interfaces>>=
	module subroutine kinematics_evaluate_radiation (k, p_in, p_out, success)
	class(kinematics_t), intent(inout) :: k
	type(vector4_t), intent(in), dimension(:) :: p_in
	type(vector4_t), intent(out), dimension(:), allocatable :: p_out
	logical, intent(out) :: success
	end subroutine kinematics_evaluate_radiation
	<<Kinematics: procedures>>=
	module subroutine kinematics_evaluate_radiation (k, p_in, p_out, success)
	class(kinematics_t), intent(inout) :: k
	type(vector4_t), intent(in), dimension(:) :: p_in
	type(vector4_t), intent(out), dimension(:), allocatable :: p_out
	logical, intent(out) :: success
	type(vector4_t), dimension(:), allocatable :: p_real
	type(vector4_t), dimension(:), allocatable :: p_born
	real(default) :: xi_max_offshell, xi_offshell, y_offshell, jac_rand_dummy, phi
	select type (phs => k%phs)
	type is (phs_fks_t)
	allocate (p_born (size (p_in)))
	if (k%threshold) then
	p_born = phs%get_onshell_projected_momenta ()
	else
	p_born = p_in
	end if
	if (.not. k%phs%lab_is_cm () .and. .not. k%threshold) then
	p_born = inverse (k%phs%lt_cm_to_lab) * p_born
	end if
	call phs%compute_xi_max (p_born, k%threshold)
	if (k%emitter >= 0) then
	allocate (p_real (size (p_born) + 1))
	allocate (p_out (size (p_born) + 1))
	if (k%emitter <= k%n_in) then
	call phs%generate_isr (k%i_phs, p_real)
	else
	if (k%threshold) then
	jac_rand_dummy = 1._default
	call compute_y_from_emitter (phs%generator%real_kinematics%x_rad (I_Y), &
	phs%generator%real_kinematics%p_born_cms%get_momenta(1), &
	k%n_in, k%emitter, .false., phs%generator%y_max, jac_rand_dummy, &
	y_offshell)
	call phs%compute_xi_max (k%emitter, k%i_phs, y_offshell, &
	phs%generator%real_kinematics%p_born_cms%get_momenta(1), &
	xi_max_offshell)
	xi_offshell = xi_max_offshell * phs%generator%real_kinematics%xi_tilde
	phi = phs%generator%real_kinematics%phi
	call phs%generate_fsr (k%emitter, k%i_phs, p_real, &
	xi_y_phi = [xi_offshell, y_offshell, phi], no_jacobians = .true.)
	call phs%generator%real_kinematics%p_real_cms%set_momenta (k%i_phs, p_real)
	call phs%generate_fsr_threshold (k%emitter, k%i_phs, p_real)
	if (debug2_active (D_SUBTRACTION)) &
	call generate_fsr_threshold_for_other_emitters (k%emitter, k%i_phs)
	else if (k%i_con > 0) then
	call phs%generate_fsr (k%emitter, k%i_phs, p_real, k%i_con)
	else
	call phs%generate_fsr (k%emitter, k%i_phs, p_real)
	end if
	end if
	success = check_scalar_products (p_real)
	if (debug2_active (D_SUBTRACTION)) then
	call msg_debug2 (D_SUBTRACTION, "Real phase-space: ")
	call vector4_write_set (p_real)
	end if
	p_out = p_real
	else
	allocate (p_out (size (p_in))); p_out = p_in
	success = .true.
	end if
	end select
	contains
	subroutine generate_fsr_threshold_for_other_emitters (emitter, i_phs)
	integer, intent(in) :: emitter, i_phs
	integer :: ii_phs, this_emitter
	select type (phs => k%phs)
	type is (phs_fks_t)
	do ii_phs = 1, size (phs%phs_identifiers)
	this_emitter = phs%phs_identifiers(ii_phs)%emitter
	if (ii_phs /= i_phs .and. this_emitter /= emitter) &
	call phs%generate_fsr_threshold (this_emitter, i_phs)
	end do
	end select
	end subroutine
	end subroutine kinematics_evaluate_radiation

	@ %def kinematics_evaluate_radiation
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Instances}

	<<[[instances.f90]]>>=
	<<File header>>

	module instances

	<<Use kinds>>
	<<Use strings>>
	use lorentz
	use mci_base
	use particles
	use sm_qcd, only: qcd_t
	use quantum_numbers
	use interactions
	use model_data
	use variables
	use sf_base
	use pdf, only: pdf_data_t
	use physics_defs
	use process_constants
	use state_matrices
	use phs_base
	use prc_core, only: prc_core_t, prc_core_state_t
	!!! local modules
	use parton_states
	use process_counter
	use pcm_base
	use pcm
	use process_config
	use process_mci
	use process
	use kinematics

	<<Standard module head>>

	<<Instances: public>>

	<<Instances: types>>

	<<Instances: interfaces>>

	interface
	<<Instances: sub interfaces>>
	end interface

	contains

	<<Instances: main procedures>>

	end module instances
	@ %def instances
	@
	<<[[instances_sub.f90]]>>=
	<<File header>>

	submodule (instances) instances_s

	<<Use debug>>
	use io_units
	use format_utils, only: write_separator
	use constants
	use diagnostics
	use numeric_utils
	use helicities
	use flavors
	use pdg_arrays, only: is_quark, is_charged_lepton, flv_eqv_expr_class

	!!! We should depend less on these modules (move it to pcm_nlo_t e.g.)
	use phs_wood, only: phs_wood_t
	use phs_fks
	- use blha_olp_interfaces, only: prc_blha_t
	+ use blha_olp_interfaces, only: prc_blha_t, OLP_RESULTS_LIMIT
	use blha_config, only: BLHA_AMP_COLOR_C
	use prc_omega, only: prc_omega_t, omega_state_t
	use prc_external, only: prc_external_t, prc_external_state_t
	use prc_threshold, only: prc_threshold_t
	use blha_olp_interfaces, only: blha_result_array_size
	use prc_openloops, only: prc_openloops_t, openloops_state_t
	+ use prc_gosam, only: prc_gosam_t
	use prc_recola, only: prc_recola_t
	use blha_olp_interfaces, only: blha_color_c_fill_offdiag, blha_color_c_fill_diag
	use ttv_formfactors, only: m1s_to_mpole
	!!! Intel oneAPI 2022/23 regression workaround
	use sm_qcd, only: qcd_t
	use prc_core, only: prc_core_t

	implicit none

	contains

	<<Instances: procedures>>

	end submodule instances_s

	@ %def instances_s
	@
	\subsection{Term instance}
	A [[term_instance_t]] object contains all data that describe a term. Each
	process component consists of one or more distinct terms which may differ in
	kinematics, but whose squared transition matrices have to be added pointwise.

	The [[active]] flag is set when this term is connected to an active
	process component. Inactive terms are skipped for kinematics and evaluation.

	The [[amp]] array stores the amplitude values when we get them from evaluating
	the associated matrix-element code.

	The [[int_hard]] interaction describes the elementary hard process.
	It receives the momenta and the amplitude entries for each sampling point.

	The [[isolated]] object holds the effective parton state for the
	elementary interaction. The amplitude entries are
	computed from [[int_hard]].

	The [[connected]] evaluator set
	convolutes this scattering matrix with the beam (and possibly
	structure-function) density matrix.

	The [[checked]] flag is set once we have applied cuts on this term.
	The result of this is stored in the [[passed]] flag.

	Although each [[term_instance]] carries a [[weight]], this currently
	always keeps the value $1$ and is only used to be given to routines
	to fulfill their signature.
	<<Instances: types>>=
	type :: term_instance_t
	type(process_term_t), pointer :: config => null ()
	class(pcm_t), pointer :: pcm => null ()
	class(pcm_workspace_t), pointer :: pcm_work => null ()
	logical :: active = .false.
	complex(default), dimension(:), allocatable :: amp
	type(interaction_t) :: int_hard
	type(isolated_state_t) :: isolated
	type(connected_state_t) :: connected
	class(prc_core_state_t), allocatable :: core_state
	logical :: checked = .false.
	logical :: passed = .false.
	logical, dimension(:), allocatable :: passed_array
	integer, dimension(:), allocatable :: i_flv_to_i_flv_rep
	real(default) :: scale = 0
	real(default), allocatable :: fac_scale
	real(default), allocatable :: ren_scale
	real(default), allocatable :: es_scale
	real(default), allocatable :: alpha_qcd_forced
	real(default) :: weight = 1
	type(vector4_t), dimension(:), allocatable :: p_seed
	type(vector4_t), dimension(:), allocatable :: p_hard
	integer :: nlo_type = BORN
	integer, dimension(:), allocatable :: same_kinematics
	logical :: negative_sf = .false.
	logical :: flv_dep_cut_eval = .false.
	contains
	<<Instances: term instance: TBP>>
	end type term_instance_t

	@ %def term_instance_t
	@
	<<Instances: term instance: TBP>>=
	procedure :: write => term_instance_write
	<<Instances: sub interfaces>>=
	module subroutine term_instance_write &
	(term, unit, kin, show_eff_state, testflag)
	class(term_instance_t), intent(in) :: term
	integer, intent(in), optional :: unit
	type(kinematics_t), intent(in), optional :: kin
	logical, intent(in), optional :: show_eff_state
	logical, intent(in), optional :: testflag
	end subroutine term_instance_write
	<<Instances: procedures>>=
	module subroutine term_instance_write &
	(term, unit, kin, show_eff_state, testflag)
	class(term_instance_t), intent(in) :: term
	integer, intent(in), optional :: unit
	type(kinematics_t), intent(in), optional :: kin
	logical, intent(in), optional :: show_eff_state
	logical, intent(in), optional :: testflag
	real(default) :: fac_scale, ren_scale
	integer :: u
	logical :: state
	u = given_output_unit (unit)
	state = .true.; if (present (show_eff_state)) state = show_eff_state
	if (term%active) then
	if (associated (term%config)) then
	write (u, "(1x,A,I0,A,I0,A)") "Term #", term%config%i_term, &
	" (component #", term%config%i_component, ")"
	else
	write (u, "(1x,A)") "Term [undefined]"
	end if
	else
	write (u, "(1x,A,I0,A)") "Term #", term%config%i_term, &
	" [inactive]"
	end if
	if (term%checked) then
	write (u, "(3x,A,L1)") "passed cuts = ", term%passed
	end if
	if (term%passed) then
	write (u, "(3x,A,ES19.12)") "overall scale = ", term%scale
	write (u, "(3x,A,ES19.12)") "factorization scale = ", term%get_fac_scale ()
	write (u, "(3x,A,ES19.12)") "renormalization scale = ", term%get_ren_scale ()
	if (allocated (term%alpha_qcd_forced)) then
	write (u, "(3x,A,ES19.12)") "alpha(QCD) forced = ", &
	term%alpha_qcd_forced
	end if
	write (u, "(3x,A,ES19.12)") "reweighting factor = ", term%weight
	end if
	!!! This used to be a member of term_instance
	if (present (kin)) then
	call kin%write (u)
	end if
	call write_separator (u)
	write (u, "(1x,A)") "Amplitude (transition matrix of the &
	&hard interaction):"
	call write_separator (u)
	call term%int_hard%basic_write (u, testflag = testflag)
	if (state .and. term%isolated%has_trace) then
	call write_separator (u)
	write (u, "(1x,A)") "Evaluators for the hard interaction:"
	call term%isolated%write (u, testflag = testflag)
	end if
	if (state .and. term%connected%has_trace) then
	call write_separator (u)
	write (u, "(1x,A)") "Evaluators for the connected process:"
	call term%connected%write (u, testflag = testflag)
	end if
	end subroutine term_instance_write

	@ %def term_instance_write
	@ The interactions and evaluators must be finalized.
	<<Instances: term instance: TBP>>=
	procedure :: final => term_instance_final
	<<Instances: sub interfaces>>=
	module subroutine term_instance_final (term)
	class(term_instance_t), intent(inout) :: term
	end subroutine term_instance_final
	<<Instances: procedures>>=
	module subroutine term_instance_final (term)
	class(term_instance_t), intent(inout) :: term
	if (allocated (term%amp)) deallocate (term%amp)
	if (allocated (term%core_state)) deallocate (term%core_state)
	if (allocated (term%ren_scale)) deallocate (term%ren_scale)
	if (allocated (term%fac_scale)) deallocate (term%fac_scale)
	if (allocated (term%es_scale)) deallocate (term%es_scale)
	if (allocated (term%alpha_qcd_forced)) &
	deallocate (term%alpha_qcd_forced)
	if (allocated (term%p_seed)) deallocate(term%p_seed)
	if (allocated (term%p_hard)) deallocate (term%p_hard)
	call term%connected%final ()
	call term%isolated%final ()
	call term%int_hard%final ()
	term%pcm => null ()
	term%pcm_work => null ()
	end subroutine term_instance_final

	@ %def term_instance_final
	@ For a new term object, we configure the structure-function
	interface, the phase space, the matrix-element (interaction)
	interface, etc.
	<<Instances: term instance: TBP>>=
	procedure :: configure => term_instance_configure
	<<Instances: sub interfaces>>=
	module subroutine term_instance_configure &
	(term_instance, process, i, pcm_work, sf_chain, kin)
	class(term_instance_t), intent(out), target :: term_instance
	type(process_t), intent(in), target :: process
	integer, intent(in) :: i
	class(pcm_workspace_t), intent(in), target :: pcm_work
	type(sf_chain_t), intent(in), target :: sf_chain
	type(kinematics_t), intent(inout), target :: kin
	end subroutine term_instance_configure
	<<Instances: procedures>>=
	module subroutine term_instance_configure &
	(term_instance, process, i, pcm_work, sf_chain, kin)
	class(term_instance_t), intent(out), target :: term_instance
	type(process_t), intent(in), target :: process
	integer, intent(in) :: i
	class(pcm_workspace_t), intent(in), target :: pcm_work
	type(sf_chain_t), intent(in), target :: sf_chain
	type(kinematics_t), intent(inout), target :: kin
	type(process_term_t) :: term
	integer :: i_component
	logical :: requires_extended_sf
	term = process%get_term_ptr (i)
	i_component = term%i_component
	if (i_component /= 0) then
	call term_instance%init &
	(process%get_pcm_ptr (), pcm_work, process%get_nlo_type_component (i_component))
	requires_extended_sf = term_instance%nlo_type == NLO_DGLAP .or. &
	(term_instance%nlo_type == NLO_REAL .and. process%get_i_sub (i) == i)
	call term_instance%setup_dynamics (process, i, kin, &
	real_finite = process%component_is_real_finite (i_component))
	select type (phs => kin%phs)
	type is (phs_fks_t)
	call term_instance%set_emitter (kin)
	call term_instance%setup_fks_kinematics (kin, &
	process%get_var_list_ptr (), &
	process%get_beam_config_ptr ())
	end select
	select type (pcm => term_instance%pcm)
	type is (pcm_nlo_t)
	call kin%set_threshold (pcm%settings%factorization_mode)
	end select
	call term_instance%setup_expressions (process%get_meta (), process%get_config ())
	end if
	end subroutine term_instance_configure

	@ %def term_instance_configure
	@ First part of term-instance configuration: initialize by assigning
	pointers to the overall [[pcm]] and the associated [[pcm_workspace]]
	objects.
	<<Instances: term instance: TBP>>=
	procedure :: init => term_instance_init
	<<Instances: sub interfaces>>=
	module subroutine term_instance_init &
	(term_instance, pcm, pcm_work, nlo_type)
	class(term_instance_t), intent(out) :: term_instance
	class(pcm_t), intent(in), target :: pcm
	class(pcm_workspace_t), intent(in), target :: pcm_work
	integer, intent(in) :: nlo_type
	end subroutine term_instance_init
	<<Instances: procedures>>=
	module subroutine term_instance_init (term_instance, pcm, pcm_work, nlo_type)
	class(term_instance_t), intent(out) :: term_instance
	class(pcm_t), intent(in), target :: pcm
	class(pcm_workspace_t), intent(in), target :: pcm_work
	integer, intent(in) :: nlo_type
	term_instance%pcm => pcm
	term_instance%pcm_work => pcm_work
	term_instance%nlo_type = nlo_type
	end subroutine term_instance_init

	@ %def term_instance_init
	@ The second part of term-instance configuration concerns dynamics, i.e., the
	interface to the matrix-element (interaction), and the parton-state
	objects that combine all kinematics and matrix-element data for evaluation.

	The hard interaction (incoming momenta) is linked to the structure
	function instance. In the isolated state, we either set pointers to
	both, or we create modified copies ([[rearrange]]) as effective
	structure-function chain and interaction, respectively.

	Finally, we set up the [[subevt]] component that will be used for
	evaluating observables, collecting particles from the trace evaluator
	in the effective connected state. Their quantum numbers must be
	determined by following back source links and set explicitly, since
	they are already eliminated in that trace.

	The [[rearrange]] parts are still commented out; they could become
	relevant for a NLO algorithm.
	<<Instances: term instance: TBP>>=
	procedure :: setup_dynamics => term_instance_setup_dynamics
	<<Instances: sub interfaces>>=
	module subroutine term_instance_setup_dynamics &
	(term, process, i_term, kin, real_finite)
	class(term_instance_t), intent(inout), target :: term
	type(process_t), intent(in), target:: process
	integer, intent(in) :: i_term
	type(kinematics_t), intent(in) :: kin
	logical, intent(in), optional :: real_finite
	end subroutine term_instance_setup_dynamics
	<<Instances: procedures>>=
	module subroutine term_instance_setup_dynamics &
	(term, process, i_term, kin, real_finite)
	class(term_instance_t), intent(inout), target :: term
	type(process_t), intent(in), target:: process
	integer, intent(in) :: i_term
	type(kinematics_t), intent(in) :: kin
	logical, intent(in), optional :: real_finite
	class(prc_core_t), pointer :: core => null ()
	type(process_beam_config_t) :: beam_config
	type(interaction_t), pointer :: sf_chain_int
	type(interaction_t), pointer :: src_int
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask_in
	type(state_matrix_t), pointer :: state_matrix
	type(flavor_t), dimension(:), allocatable :: flv_int, flv_src, f_in, f_out
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	type(flavor_t), dimension(:,:), allocatable :: flv_pdf
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn_pdf
	integer :: n_in, n_vir, n_out, n_tot, n_sub
	integer :: n_flv_born, n_flv_real, n_flv_total
	integer :: i, j
	logical :: me_already_squared, keep_fs_flavors
	logical :: decrease_n_tot
	logical :: requires_extended_sf
	me_already_squared = .false.
	keep_fs_flavors = .false.
	term%config => process%get_term_ptr (i_term)
	term%int_hard = term%config%int
	core => process%get_core_term (i_term)
	term%negative_sf = process%get_negative_sf ()
	call core%allocate_workspace (term%core_state)
	select type (core)
	class is (prc_external_t)
	call reduce_interaction (term%int_hard, &
	core%includes_polarization (), .true., .false.)
	me_already_squared = .true.
	allocate (term%amp (term%int_hard%get_n_matrix_elements ()))
	class default
	allocate (term%amp (term%config%n_allowed))
	end select
	if (allocated (term%core_state)) then
	select type (core_state => term%core_state)
	type is (openloops_state_t)
	call core_state%init_threshold (process%get_model_ptr ())
	end select
	end if
	term%amp = cmplx (0, 0, default)
	decrease_n_tot = term%nlo_type == NLO_REAL .and. &
	term%config%i_term_global /= term%config%i_sub
	if (present (real_finite)) then
	if (real_finite) decrease_n_tot = .false.
	end if
	if (decrease_n_tot) then
	allocate (term%p_seed (term%int_hard%get_n_tot () - 1))
	else
	allocate (term%p_seed (term%int_hard%get_n_tot ()))
	end if
	allocate (term%p_hard (term%int_hard%get_n_tot ()))
	sf_chain_int => kin%sf_chain%get_out_int_ptr ()
	n_in = term%int_hard%get_n_in ()
	do j = 1, n_in
	i = kin%sf_chain%get_out_i (j)
	call term%int_hard%set_source_link (j, sf_chain_int, i)
	end do
	call term%isolated%init (kin%sf_chain, term%int_hard)
	allocate (mask_in (n_in))
	mask_in = kin%sf_chain%get_out_mask ()
	select type (phs => kin%phs)
	type is (phs_wood_t)
	if (me_already_squared) then
	call term%isolated%setup_identity_trace &
	(core, mask_in, .true., .false.)
	else
	call term%isolated%setup_square_trace &
	(core, mask_in, term%config%col, .false.)
	end if
	type is (phs_fks_t)
	select case (phs%mode)
	case (PHS_MODE_ADDITIONAL_PARTICLE)
	if (me_already_squared) then
	call term%isolated%setup_identity_trace &
	(core, mask_in, .true., .false.)
	else
	keep_fs_flavors = term%config%data%n_flv > 1
	call term%isolated%setup_square_trace &
	(core, mask_in, term%config%col, &
	keep_fs_flavors)
	end if
	case (PHS_MODE_COLLINEAR_REMNANT)
	if (me_already_squared) then
	call term%isolated%setup_identity_trace &
	(core, mask_in, .true., .false.)
	else
	call term%isolated%setup_square_trace &
	(core, mask_in, term%config%col, .false.)
	end if
	end select
	class default
	call term%isolated%setup_square_trace &
	(core, mask_in, term%config%col, .false.)
	end select
	if (term%nlo_type == NLO_VIRTUAL .or. (term%nlo_type == NLO_REAL .and. &
	term%config%i_term_global == term%config%i_sub) .or. &
	term%nlo_type == NLO_MISMATCH) then
	n_sub = term%get_n_sub ()
	else if (term%nlo_type == NLO_DGLAP) then
	n_sub = n_beams_rescaled + term%get_n_sub ()
	else
	!!! No integration of real subtraction in interactions yet
	n_sub = 0
	end if
	keep_fs_flavors = keep_fs_flavors .or. me_already_squared
	requires_extended_sf = term%nlo_type == NLO_DGLAP .or. &
	(term%is_subtraction () .and. process%pcm_contains_pdfs ())
	call term%connected%setup_connected_trace (term%isolated, &
	undo_helicities = undo_helicities (core, me_already_squared), &
	keep_fs_flavors = keep_fs_flavors, &
	requires_extended_sf = requires_extended_sf)
	associate (int_eff => term%isolated%int_eff)
	state_matrix => int_eff%get_state_matrix_ptr ()
	n_tot = int_eff%get_n_tot ()
	flv_int = quantum_numbers_get_flavor &
	(state_matrix%get_quantum_number (1))
	allocate (f_in (n_in))
	f_in = flv_int(1:n_in)
	deallocate (flv_int)
	end associate
	n_in = term%connected%trace%get_n_in ()
	n_vir = term%connected%trace%get_n_vir ()
	n_out = term%connected%trace%get_n_out ()
	allocate (f_out (n_out))
	do j = 1, n_out
	call term%connected%trace%find_source &
	(n_in + n_vir + j, src_int, i)
	if (associated (src_int)) then
	state_matrix => src_int%get_state_matrix_ptr ()
	flv_src = quantum_numbers_get_flavor &
	(state_matrix%get_quantum_number (1))
	f_out(j) = flv_src(i)
	deallocate (flv_src)
	end if
	end do

	beam_config = process%get_beam_config ()
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	term%flv_dep_cut_eval = pcm%settings%nlo_correction_type == "EW" &
	.and. pcm%region_data%alphas_power > 0 &
	.and. any(is_charged_lepton(f_out%get_pdg()))
	end select

	call term%connected%setup_subevt (term%isolated%sf_chain_eff, &
	beam_config%data%flv, f_in, f_out)
	call term%connected%setup_var_list &
	(process%get_var_list_ptr (), beam_config%data)
	! Does connected%trace never have any helicity qn?
	call term%init_interaction_qn_index (core, term%connected%trace, n_sub, &
	process%get_model_ptr (), is_polarized = .false.)
	call term%init_interaction_qn_index &
	(core, term%int_hard, n_sub, process%get_model_ptr ())
	call term%init_eqv_expr_classes ()
	if (requires_extended_sf) then
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	n_in = pcm%region_data%get_n_in ()
	flv_born = pcm%region_data%get_flv_states_born ()
	flv_real = pcm%region_data%get_flv_states_real ()
	n_flv_born = pcm%region_data%get_n_flv_born ()
	n_flv_real = pcm%region_data%get_n_flv_real ()
	n_flv_total = n_flv_born + n_flv_real
	allocate (flv_pdf(n_in, n_flv_total), &
	qn_pdf(n_in, n_flv_total))
	call flv_pdf(:, :n_flv_born)%init (flv_born(:n_in, :))
	call flv_pdf(:, n_flv_born + 1:n_flv_total)%init (flv_real(:n_in, :))
	call qn_pdf%init (flv_pdf)
	call sf_chain_int%init_qn_index (qn_pdf, n_flv_born, n_flv_real)
	end select
	end if
	contains

	function undo_helicities (core, me_squared) result (val)
	logical :: val
	class(prc_core_t), intent(in) :: core
	logical, intent(in) :: me_squared
	select type (core)
	class is (prc_external_t)
	val = me_squared .and. .not. core%includes_polarization ()
	class default
	val = .false.
	end select
	end function undo_helicities

	subroutine reduce_interaction (int, polarized_beams, keep_fs_flavors, &
	keep_colors)
	type(interaction_t), intent(inout) :: int
	logical, intent(in) :: polarized_beams
	logical, intent(in) :: keep_fs_flavors, keep_colors
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
	logical, dimension(:), allocatable :: mask_f, mask_c, mask_h
	integer :: n_tot, n_in
	n_in = int%get_n_in (); n_tot = int%get_n_tot ()
	allocate (qn_mask (n_tot))
	allocate (mask_f (n_tot), mask_c (n_tot), mask_h (n_tot))
	mask_c = .not. keep_colors
	mask_f (1 : n_in) = .false.
	if (keep_fs_flavors) then
	mask_f (n_in + 1 : ) = .false.
	else
	mask_f (n_in + 1 : ) = .true.
	end if
	if (polarized_beams) then
	mask_h (1 : n_in) = .false.
	else
	mask_h (1 : n_in) = .true.
	end if
	mask_h (n_in + 1 : ) = .true.
	call qn_mask%init (mask_f, mask_c, mask_h)
	call int%reduce_state_matrix (qn_mask, keep_order = .true.)
	end subroutine reduce_interaction
	end subroutine term_instance_setup_dynamics

	@ %def term_instance_setup_dynamics
	@ Set up index mapping from state matrix to index pair [[i_flv]], [[i_sub]].
	<<Instances: public>>=
	public :: setup_interaction_qn_index
	<<Instances: sub interfaces>>=
	module subroutine setup_interaction_qn_index &
	(int, data, qn_config, n_sub, is_polarized)
	class(interaction_t), intent(inout) :: int
	class(process_constants_t), intent(in) :: data
	type(quantum_numbers_t), dimension(:, :), intent(in) :: qn_config
	integer, intent(in) :: n_sub
	logical, intent(in) :: is_polarized
	end subroutine setup_interaction_qn_index
	<<Instances: procedures>>=
	module subroutine setup_interaction_qn_index &
	(int, data, qn_config, n_sub, is_polarized)
	class(interaction_t), intent(inout) :: int
	class(process_constants_t), intent(in) :: data
	type(quantum_numbers_t), dimension(:, :), intent(in) :: qn_config
	integer, intent(in) :: n_sub
	logical, intent(in) :: is_polarized
	integer :: i
	type(quantum_numbers_t), dimension(:, :), allocatable :: qn_hel
	if (is_polarized) then
	call setup_interaction_qn_hel (int, data, qn_hel)
	call int%init_qn_index (qn_config, n_sub, qn_hel)
	call int%set_qn_index_helicity_flip (.true.)
	else
	call int%init_qn_index (qn_config, n_sub)
	end if
	end subroutine setup_interaction_qn_index

	@ %def setup_interaction_qn_index
	@ Set up beam polarisation quantum numbers, if beam polarisation is required.

	We retrieve the full helicity information from [[term%config%data]] and reduce
	the information only to the inital state. Afterwards, we uniquify the initial
	state polarization by a applying an index (hash) table.

	The helicity information is fed into an array of quantum numbers to assign
	flavor, helicity and subtraction indices correctly to their matrix element.
	<<Instances: public>>=
	public :: setup_interaction_qn_hel
	<<Instances: sub interfaces>>=
	module subroutine setup_interaction_qn_hel (int, data, qn_hel)
	class(interaction_t), intent(in) :: int
	class(process_constants_t), intent(in) :: data
	type(quantum_numbers_t), dimension(:, :), allocatable, intent(out) :: &
	qn_hel
	end subroutine setup_interaction_qn_hel
	<<Instances: procedures>>=
	module subroutine setup_interaction_qn_hel (int, data, qn_hel)
	class(interaction_t), intent(in) :: int
	class(process_constants_t), intent(in) :: data
	type(quantum_numbers_t), dimension(:, :), allocatable, intent(out) :: &
	qn_hel
	type(helicity_t), dimension(:), allocatable :: hel
	integer, dimension(:), allocatable :: index_table
	integer, dimension(:, :), allocatable :: hel_state
	integer :: i, j, n_hel_unique
	associate (n_in => int%get_n_in (), n_tot => int%get_n_tot ())
	allocate (hel_state (n_tot, data%get_n_hel ()), &
	source = data%hel_state)
	allocate (index_table (data%get_n_hel ()), &
	source = 0)
	forall (j=1:data%get_n_hel (), i=n_in+1:n_tot) hel_state(i, j) = 0
	n_hel_unique = 0
	HELICITY: do i = 1, data%get_n_hel ()
	do j = 1, data%get_n_hel ()
	if (index_table (j) == 0) then
	index_table(j) = i; n_hel_unique = n_hel_unique + 1
	cycle HELICITY
	else if (all (hel_state(:, i) == &
	hel_state(:, index_table(j)))) then
	cycle HELICITY
	end if
	end do
	end do HELICITY
	allocate (qn_hel (n_tot, n_hel_unique))
	allocate (hel (n_tot))
	do j = 1, n_hel_unique
	call hel%init (hel_state(:, index_table(j)))
	call qn_hel(:, j)%init (hel)
	end do
	end associate
	end subroutine setup_interaction_qn_hel

	@ %def setup_interaction_qn_hel
	@ Initialization of equivalent cut expression classes.

	Each flavor index [[i_flv]] here is assigned to the corresponding one
	representative for an equivalent cut expression class. This class describes
	the set of flavor quantum numbers for which the phase space cut expression
	evaluation yield the same output. The representative [[i_flv]] for one class
	correspond to the first flavor quantum numbers of that kind occuring in the
	state matrix.
	<<Instances: term instance: TBP>>=
	procedure :: init_eqv_expr_classes => term_instance_init_eqv_expr_classes
	<<Instances: sub interfaces>>=
	module subroutine term_instance_init_eqv_expr_classes (term)
	class(term_instance_t), intent(inout), target :: term
	end subroutine term_instance_init_eqv_expr_classes
	<<Instances: procedures>>=
	module subroutine term_instance_init_eqv_expr_classes (term)
	class(term_instance_t), intent(inout), target :: term
	type(interaction_t), pointer :: src_int
	type(state_matrix_t), pointer :: state_matrix
	type(flavor_t), dimension(:), allocatable :: flv_src
	logical, dimension(:,:,:), allocatable :: eqv_expr_class
	logical, dimension (:), allocatable :: evaluated
	integer :: n_in, n_vir, n_out
	integer :: k, j, i
	n_in = term%connected%trace%get_n_in ()
	n_vir = term%connected%trace%get_n_vir ()
	n_out = term%connected%trace%get_n_out ()
	allocate (eqv_expr_class (3, n_out, &
	term%connected%trace%get_qn_index_n_flv ()))
	do k = 1, term%connected%trace%get_qn_index_n_flv ()
	do j = 1, n_out
	call term%connected%trace%find_source &
	(n_in + n_vir + j, src_int, i)
	if (associated (src_int)) then
	state_matrix => src_int%get_state_matrix_ptr ()
	flv_src = quantum_numbers_get_flavor &
	(state_matrix%get_quantum_number (k))
	eqv_expr_class (:, j, k) = flv_eqv_expr_class (flv_src(i)%get_pdg())
	deallocate (flv_src)
	end if
	end do
	end do
	if (term%flv_dep_cut_eval) then
	allocate (evaluated (term%connected%trace%get_qn_index_n_flv ()))
	evaluated = .false.
	allocate (term%i_flv_to_i_flv_rep (term%connected%trace%get_qn_index_n_flv ()))
	do i = 1, term%connected%trace%get_qn_index_n_flv ()
	if (.not. evaluated (i)) then
	do k = i, term%connected%trace%get_qn_index_n_flv ()
	if (same_eqv_expr_class(eqv_expr_class (:,:,i), eqv_expr_class (:,:,k))) then
	term%i_flv_to_i_flv_rep (k) = i
	evaluated (k) = .true.
	end if
	end do
	end if
	end do
	end if

	contains

	function same_eqv_expr_class (flv_mask1, flv_mask2) result (same)
	logical, dimension (:,:), intent(in) :: flv_mask1, flv_mask2
	logical :: same
	integer :: l
	same = .true.
	do l = 1, size (flv_mask1, dim = 2)
	same = same .and. all (flv_mask1(:,l) .eqv. flv_mask2(:,l))
	end do
	end function same_eqv_expr_class
	end subroutine term_instance_init_eqv_expr_classes

	@ %def term_instance_init_eqv_expr_classes
	@
	<<Instances: term instance: TBP>>=
	procedure :: init_interaction_qn_index => &
	term_instance_init_interaction_qn_index
	<<Instances: sub interfaces>>=
	module subroutine term_instance_init_interaction_qn_index (term, core, &
	int, n_sub, model, is_polarized)
	class(term_instance_t), intent(inout), target :: term
	class(prc_core_t), intent(in) :: core
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: n_sub
	class(model_data_t), intent(in) :: model
	logical, intent(in), optional :: is_polarized
	end subroutine term_instance_init_interaction_qn_index
	<<Instances: procedures>>=
	module subroutine term_instance_init_interaction_qn_index (term, core, &
	int, n_sub, model, is_polarized)
	class(term_instance_t), intent(inout), target :: term
	class(prc_core_t), intent(in) :: core
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: n_sub
	class(model_data_t), intent(in) :: model
	logical, intent(in), optional :: is_polarized
	logical :: polarized
	type(quantum_numbers_t), dimension(:, :), allocatable :: qn_config
	integer, dimension(:,:), allocatable :: flv_born
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: i
	select type (core)
	class is (prc_external_t)
	if (present (is_polarized)) then
	polarized = is_polarized
	else
	polarized = core%includes_polarization ()
	end if
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	associate (is_born => .not. (term%nlo_type == NLO_REAL .and. &
	.not. term%is_subtraction ()))
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	qn_config = pcm%get_qn (is_born)
	end select
	call setup_interaction_qn_index (int, term%config%data, &
	qn_config, n_sub, polarized)
	end associate
	class default
	call term%config%data%get_flv_state (flv_born)
	allocate (flv (size (flv_born, dim = 1)))
	allocate (qn_config (size (flv_born, dim = 1), size (flv_born, dim = 2)))
	do i = 1, core%data%n_flv
	call flv%init (flv_born(:,i), model)
	call qn_config(:, i)%init (flv)
	end do
	call setup_interaction_qn_index (int, term%config%data, &
	qn_config, n_sub, polarized)
	end select
	class default
	call int%init_qn_index ()
	end select
	end subroutine term_instance_init_interaction_qn_index

	@ %def term_instance_init_interaction_qn_index
	@
	<<Instances: term instance: TBP>>=
	procedure :: setup_fks_kinematics => term_instance_setup_fks_kinematics
	<<Instances: sub interfaces>>=
	module subroutine term_instance_setup_fks_kinematics &
	(term, kin, var_list, beam_config)
	class(term_instance_t), intent(inout), target :: term
	type(kinematics_t), intent(inout) :: kin
	type(var_list_t), intent(in) :: var_list
	type(process_beam_config_t), intent(in) :: beam_config
	end subroutine term_instance_setup_fks_kinematics
	<<Instances: procedures>>=
	module subroutine term_instance_setup_fks_kinematics &
	(term, kin, var_list, beam_config)
	class(term_instance_t), intent(inout), target :: term
	type(kinematics_t), intent(inout) :: kin
	type(var_list_t), intent(in) :: var_list
	type(process_beam_config_t), intent(in) :: beam_config
	integer :: mode
	logical :: singular_jacobian
	if (.not. (term%nlo_type == NLO_REAL .or. term%nlo_type == NLO_DGLAP .or. &
	term%nlo_type == NLO_MISMATCH)) return
	singular_jacobian = var_list%get_lval &
	(var_str ("?powheg_use_singular_jacobian"))
	if (term%nlo_type == NLO_REAL) then
	mode = check_generator_mode (GEN_REAL_PHASE_SPACE)
	else if (term%nlo_type == NLO_MISMATCH) then
	mode = check_generator_mode (GEN_SOFT_MISMATCH)
	else
	mode = PHS_MODE_UNDEFINED
	end if
	select type (phs => kin%phs)
	type is (phs_fks_t)
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	call pcm%setup_phs_generator (pcm_work, &
	phs%generator, phs%config%sqrts, mode, singular_jacobian)
	if (beam_config%has_structure_function ()) then
	pcm_work%isr_kinematics%isr_mode = SQRTS_VAR
	else
	pcm_work%isr_kinematics%isr_mode = SQRTS_FIXED
	end if
	if (debug_on) call msg_debug &
	(D_PHASESPACE, "isr_mode: ", pcm_work%isr_kinematics%isr_mode)
	end select
	end select
	class default
	call msg_fatal ("Phase space should be an FKS phase space!")
	end select
	contains
	function check_generator_mode (gen_mode_default) result (gen_mode)
	integer :: gen_mode
	integer, intent(in) :: gen_mode_default
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	associate (settings => pcm%settings)
	if (settings%test_coll_limit .and. settings%test_anti_coll_limit) &
	call msg_fatal ("You cannot check the collinear and anti-collinear limit "&
	&"at the same time!")
	if (settings%test_soft_limit .and. .not. settings%test_coll_limit &
	.and. .not. settings%test_anti_coll_limit) then
	gen_mode = GEN_SOFT_LIMIT_TEST
	else if (.not. settings%test_soft_limit .and. settings%test_coll_limit) then
	gen_mode = GEN_COLL_LIMIT_TEST
	else if (.not. settings%test_soft_limit .and. settings%test_anti_coll_limit) then
	gen_mode = GEN_ANTI_COLL_LIMIT_TEST
	else if (settings%test_soft_limit .and. settings%test_coll_limit) then
	gen_mode = GEN_SOFT_COLL_LIMIT_TEST
	else if (settings%test_soft_limit .and. settings%test_anti_coll_limit) then
	gen_mode = GEN_SOFT_ANTI_COLL_LIMIT_TEST
	else
	gen_mode = gen_mode_default
	end if
	end associate
	end select
	end function check_generator_mode
	end subroutine term_instance_setup_fks_kinematics

	@ %def term_instance_setup_fks_kinematics
	@ Set up seed kinematics, starting from the MC parameter set given as
	argument. As a result, the [[k_seed]] kinematics object is evaluated
	(except for the structure-function matrix-element evaluation, which we
	postpone until we know the factorization scale), and we have a valid
	[[p_seed]] momentum array.
	<<Instances: term instance: TBP>>=
	procedure :: compute_seed_kinematics => term_instance_compute_seed_kinematics
	<<Instances: sub interfaces>>=
	module subroutine term_instance_compute_seed_kinematics &
	(term, kin, mci_work, phs_channel, success)
	class(term_instance_t), intent(inout), target :: term
	type(kinematics_t), intent(inout) :: kin
	type(mci_work_t), intent(in) :: mci_work
	integer, intent(in) :: phs_channel
	logical, intent(out) :: success
	end subroutine term_instance_compute_seed_kinematics
	<<Instances: procedures>>=
	module subroutine term_instance_compute_seed_kinematics &
	(term, kin, mci_work, phs_channel, success)
	class(term_instance_t), intent(inout), target :: term
	type(kinematics_t), intent(inout) :: kin
	type(mci_work_t), intent(in) :: mci_work
	integer, intent(in) :: phs_channel
	logical, intent(out) :: success
	call kin%compute_selected_channel &
	(mci_work, phs_channel, term%p_seed, success)
	end subroutine term_instance_compute_seed_kinematics

	@ %def term_instance_compute_seed_kinematics
	@
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_projections => term_instance_evaluate_projections
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_projections (term, kin)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(inout) :: kin
	end subroutine term_instance_evaluate_projections
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_projections (term, kin)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(inout) :: kin
	if (kin%threshold .and. term%nlo_type > BORN) then
	if (debug2_active (D_THRESHOLD)) &
	print *, 'Evaluate on-shell projection: ', &
	char (component_status (term%nlo_type))
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	call kin%threshold_projection (pcm_work, term%nlo_type)
	end select
	end if
	end subroutine term_instance_evaluate_projections

	@ %def term_instance_evaluate_projections
	@ Compute the momenta in the hard interactions, one for each term that
	constitutes this process component. In simple cases this amounts to
	just copying momenta. In more advanced cases, we may generate
	distinct sets of momenta from the seed kinematics.

	The interactions in the term instances are accessed individually. We may
	choose to calculate all terms at once together with the seed kinematics, use
	[[component%core_state]] for storage, and just fill the interactions here.
	<<Instances: term instance: TBP>>=
	procedure :: compute_hard_kinematics => &
	term_instance_compute_hard_kinematics
	<<Instances: sub interfaces>>=
	module subroutine term_instance_compute_hard_kinematics &
	(term, kin, recover, skip_term, success)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(inout) :: kin
	integer, intent(in), optional :: skip_term
	logical, intent(in), optional :: recover
	logical, intent(out) :: success
	end subroutine term_instance_compute_hard_kinematics
	<<Instances: procedures>>=
	module subroutine term_instance_compute_hard_kinematics &
	(term, kin, recover, skip_term, success)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(inout) :: kin
	integer, intent(in), optional :: skip_term
	logical, intent(in), optional :: recover
	logical, intent(out) :: success
	type(vector4_t), dimension(:), allocatable :: p
	if (allocated (term%core_state)) &
	call term%core_state%reset_new_kinematics ()
	if (present (skip_term)) then
	if (term%config%i_term_global == skip_term) return
	end if

	if (present (recover)) then
	if (recover) return
	end if
	if (term%nlo_type == NLO_REAL .and. kin%emitter >= 0) then
	call kin%evaluate_radiation (term%p_seed, p, success)
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	if (pcm%dalitz_plot%active) then
	if (kin%emitter > kin%n_in) then
	if (p(kin%emitter)**2 > tiny_07) &
	call pcm%register_dalitz_plot (kin%emitter, p)
	end if
	end if
	end select
	else if (is_subtraction_component (kin%emitter, term%nlo_type)) then
	call kin%modify_momenta_for_subtraction (term%p_seed, p)
	success = .true.
	else
	allocate (p (size (term%p_seed))); p = term%p_seed
	success = .true.
	end if
	call term%int_hard%set_momenta (p)
	if (debug_on) then
	call msg_debug2 (D_REAL, "inside compute_hard_kinematics")
	if (debug2_active (D_REAL)) call vector4_write_set (p)
	end if
	end subroutine term_instance_compute_hard_kinematics

	@ %def term_instance_compute_hard_kinematics
	@ Here, we invert this. We fetch the incoming momenta which reside
	in the appropriate [[sf_chain]] object, stored within the [[k_seed]]
	subobject. On the other hand, we have the outgoing momenta of the
	effective interaction. We rely on the process core to compute the
	remaining seed momenta and to fill the momenta within the hard
	interaction. (The latter is trivial if hard and effective interaction
	coincide.)

	After this is done, the incoming momenta in the trace evaluator that
	corresponds to the hard (effective) interaction, are still
	left undefined. We remedy this by calling [[receive_kinematics]] once.
	<<Instances: term instance: TBP>>=
	procedure :: recover_seed_kinematics => &
	term_instance_recover_seed_kinematics
	<<Instances: sub interfaces>>=
	module subroutine term_instance_recover_seed_kinematics &
	(term, kin, p_seed_ref)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(in) :: kin
	type(vector4_t), dimension(:), intent(in), optional :: p_seed_ref
	end subroutine term_instance_recover_seed_kinematics
	<<Instances: procedures>>=
	module subroutine term_instance_recover_seed_kinematics &
	(term, kin, p_seed_ref)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(in) :: kin
	integer :: n_in
	type(vector4_t), dimension(:), intent(in), optional :: p_seed_ref
	n_in = kin%n_in
	call kin%get_incoming_momenta (term%p_seed(1:n_in))
	associate (int_eff => term%isolated%int_eff)
	call int_eff%set_momenta (term%p_seed(1:n_in), outgoing = .false.)
	if (present (p_seed_ref)) then
	term%p_seed(n_in + 1 : ) = p_seed_ref
	else
	term%p_seed(n_in + 1 : ) = int_eff%get_momenta (outgoing = .true.)
	end if
	end associate
	call term%isolated%receive_kinematics ()
	end subroutine term_instance_recover_seed_kinematics

	@ %def term_instance_recover_seed_kinematics
	@ Compute the integration parameters for all channels except the selected
	one.
	JRR: Obsolete now.
	<<XXX Instances: term instance: TBP>>=
	procedure :: compute_other_channels => &
	term_instance_compute_other_channels
	<<XXX Instances: procedures>>=
	subroutine term_instance_compute_other_channels &
	(term, mci_work, phs_channel)
	class(term_instance_t), intent(inout), target :: term
	type(mci_work_t), intent(in) :: mci_work
	integer, intent(in) :: phs_channel
	call term%k_term%compute_other_channels (mci_work, phs_channel)
	end subroutine term_instance_compute_other_channels

	@ %def term_instance_compute_other_channels
	@ Recover beam momenta, i.e., return the beam momenta as currently
	stored in the kinematics subobject to their source. This is a side effect.
	JRR: Obsolete now.
	<<XXX Instances: term instance: TBP>>=
	procedure :: return_beam_momenta => term_instance_return_beam_momenta
	<<XXX Instances: procedures>>=
	subroutine term_instance_return_beam_momenta (term)
	class(term_instance_t), intent(in) :: term
	call term%k_term%return_beam_momenta ()
	end subroutine term_instance_return_beam_momenta

	@ %def term_instance_return_beam_momenta
	@
	Applies the real partition by computing the real partition function $F(\Phi)$
	and multiplying either $\mathcal{R}_\text{sin} = \mathcal{R} \cdot F$ or
	$\mathcal{R}_\text{fin} = \mathcal{R} \cdot (1-F)$.
	<<Instances: term instance: TBP>>=
	procedure :: apply_real_partition => term_instance_apply_real_partition
	<<Instances: sub interfaces>>=
	module subroutine term_instance_apply_real_partition (term, kin)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(in) :: kin
	end subroutine term_instance_apply_real_partition
	<<Instances: procedures>>=
	module subroutine term_instance_apply_real_partition (term, kin)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(in) :: kin
	real(default) :: f, sqme
	integer :: i_component
	integer :: i_amp, n_amps, qn_index
	logical :: is_subtraction
	i_component = term%config%i_component
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	if (pcm%component_selected (i_component) .and. &
	pcm%nlo_type (i_component) == NLO_REAL) then
	is_subtraction = pcm%component_type (i_component) == &
	COMP_REAL_SING .and. kin%emitter < 0
	if (is_subtraction) return
	select case (pcm%component_type (i_component))
	case (COMP_REAL_FIN)
	call term%connected%trace%set_duplicate_flv_zero()
	end select
	f = pcm%real_partition%get_f (term%p_hard)
	n_amps = term%connected%trace%get_n_matrix_elements ()
	do i_amp = 1, n_amps
	qn_index = term%connected%trace%get_qn_index (i_amp, i_sub = 0)
	if (term%passed_array(i_amp) .or. .not. term%passed) then
	sqme = real (term%connected%trace%get_matrix_element (qn_index))
	else
	sqme = zero
	end if
	if (debug_on) call msg_debug2 &
	(D_PROCESS_INTEGRATION, "term_instance_apply_real_partition")
	select case (pcm%component_type (i_component))
	case (COMP_REAL_FIN)
	if (debug_on) call msg_debug2 &
	(D_PROCESS_INTEGRATION, "Real finite")
	sqme = sqme * (one - f)
	case (COMP_REAL_SING)
	if (debug_on) call msg_debug2 &
	(D_PROCESS_INTEGRATION, "Real singular")
	sqme = sqme * f
	end select
	if (debug_on) call msg_debug2 &
	(D_PROCESS_INTEGRATION, "apply_damping: sqme", sqme)
	call term%connected%trace%set_matrix_element &
	(qn_index, cmplx (sqme, zero, default))
	end do
	end if
	end select
	end subroutine term_instance_apply_real_partition

	@ %def term_instance_apply_real_partition
	@
	<<Instances: term instance: TBP>>=
	procedure :: get_p_hard => term_instance_get_p_hard
	<<Instances: sub interfaces>>=
	pure module function term_instance_get_p_hard &
	(term_instance) result (p_hard)
	type(vector4_t), dimension(:), allocatable :: p_hard
	class(term_instance_t), intent(in) :: term_instance
	end function term_instance_get_p_hard
	<<Instances: procedures>>=
	pure module function term_instance_get_p_hard (term_instance) result (p_hard)
	type(vector4_t), dimension(:), allocatable :: p_hard
	class(term_instance_t), intent(in) :: term_instance
	allocate (p_hard (size (term_instance%p_hard)))
	p_hard = term_instance%p_hard
	end function term_instance_get_p_hard

	@ %def term_instance_get_p_hard
	@
	<<Instances: term instance: TBP>>=
	procedure :: set_emitter => term_instance_set_emitter
	<<Instances: sub interfaces>>=
	module subroutine term_instance_set_emitter (term, kin)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(inout) :: kin
	end subroutine term_instance_set_emitter
	<<Instances: procedures>>=
	module subroutine term_instance_set_emitter (term, kin)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(inout) :: kin
	integer :: i_phs
	logical :: set_emitter
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	select type (phs => kin%phs)
	type is (phs_fks_t)
	!!! Without resonances, i_alr = i_phs
	i_phs = term%config%i_term
	kin%i_phs = i_phs
	set_emitter = i_phs <= pcm%region_data%n_phs .and. &
	term%nlo_type == NLO_REAL
	if (set_emitter) then
	kin%emitter = phs%phs_identifiers(i_phs)%emitter
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	if (allocated (pcm%region_data%i_phs_to_i_con)) &
	kin%i_con = pcm%region_data%i_phs_to_i_con (i_phs)
	end select
	end if
	end select
	end select
	end subroutine term_instance_set_emitter

	@ %def term_instance_set_emitter
	@ For initializing the expressions, we need the local variable list and the
	parse trees.
	<<Instances: term instance: TBP>>=
	procedure :: setup_expressions => term_instance_setup_expressions
	<<Instances: sub interfaces>>=
	module subroutine term_instance_setup_expressions (term, meta, config)
	class(term_instance_t), intent(inout), target :: term
	type(process_metadata_t), intent(in), target :: meta
	type(process_config_data_t), intent(in) :: config
	end subroutine term_instance_setup_expressions
	<<Instances: procedures>>=
	module subroutine term_instance_setup_expressions (term, meta, config)
	class(term_instance_t), intent(inout), target :: term
	type(process_metadata_t), intent(in), target :: meta
	type(process_config_data_t), intent(in) :: config
	if (allocated (config%ef_cuts)) &
	call term%connected%setup_cuts (config%ef_cuts)
	if (allocated (config%ef_scale)) &
	call term%connected%setup_scale (config%ef_scale)
	if (allocated (config%ef_fac_scale)) &
	call term%connected%setup_fac_scale (config%ef_fac_scale)
	if (allocated (config%ef_ren_scale)) &
	call term%connected%setup_ren_scale (config%ef_ren_scale)
	if (allocated (config%ef_weight)) &
	call term%connected%setup_weight (config%ef_weight)
	end subroutine term_instance_setup_expressions

	@ %def term_instance_setup_expressions
	@ Prepare the extra evaluators that we need for processing events.

	The matrix elements we get from OpenLoops and GoSam are already squared
	and summed over color and helicity. They should not be squared again.
	<<Instances: term instance: TBP>>=
	procedure :: setup_event_data => term_instance_setup_event_data
	<<Instances: sub interfaces>>=
	module subroutine term_instance_setup_event_data (term, kin, core, model)
	class(term_instance_t), intent(inout), target :: term
	type(kinematics_t), intent(in) :: kin
	class(prc_core_t), intent(in) :: core
	class(model_data_t), intent(in), target :: model
	end subroutine term_instance_setup_event_data
	<<Instances: procedures>>=
	module subroutine term_instance_setup_event_data (term, kin, core, model)
	class(term_instance_t), intent(inout), target :: term
	type(kinematics_t), intent(in) :: kin
	class(prc_core_t), intent(in) :: core
	class(model_data_t), intent(in), target :: model
	integer :: n_in
	logical :: mask_color
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask_in
	n_in = term%int_hard%get_n_in ()
	allocate (mask_in (n_in))
	mask_in = kin%sf_chain%get_out_mask ()
	call setup_isolated (term%isolated, core, model, mask_in, term%config%col)
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	mask_color = pcm_work%is_fixed_order_nlo_events ()
	class default
	mask_color = .false.
	end select
	call setup_connected (term%connected, term%isolated, core, &
	term%nlo_type, mask_color)
	contains
	subroutine setup_isolated (isolated, core, model, mask, color)
	type(isolated_state_t), intent(inout), target :: isolated
	class(prc_core_t), intent(in) :: core
	class(model_data_t), intent(in), target :: model
	type(quantum_numbers_mask_t), intent(in), dimension(:) :: mask
	integer, intent(in), dimension(:) :: color
	select type (core)
	class is (prc_blha_t)
	call isolated%matrix%init_identity(isolated%int_eff)
	isolated%has_matrix = .true.
	class default
	call isolated%setup_square_matrix (core, model, mask, color)
	end select
	!!! TODO (PS-09-10-20) We should not square the flows
	!!! if they come from BLHA either
	call isolated%setup_square_flows (core, model, mask)
	end subroutine setup_isolated

	subroutine setup_connected (connected, isolated, core, nlo_type, mask_color)
	type(connected_state_t), intent(inout), target :: connected
	type(isolated_state_t), intent(in), target :: isolated
	class(prc_core_t), intent(in) :: core
	integer, intent(in) :: nlo_type
	logical, intent(in) :: mask_color
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
	call connected%setup_connected_matrix (isolated)
	if (term%nlo_type == NLO_VIRTUAL .or. (term%nlo_type == NLO_REAL &
	.and. term%config%i_term_global == term%config%i_sub) &
	.or. term%nlo_type == NLO_DGLAP) then
	!!! We do not care about the subtraction matrix elements in
	!!! connected%matrix, because all entries there are supposed
	!!! to be squared. To be able to match with flavor quantum numbers,
	!!! we remove the subtraction quantum entries from the state matrix.
	allocate (mask (connected%matrix%get_n_tot()))
	call mask%set_sub (1)
	call connected%matrix%reduce_state_matrix (mask, keep_order = .true.)
	end if
	call term%init_interaction_qn_index (core, connected%matrix, 0, model, &
	is_polarized = .false.)
	select type (core)
	class is (prc_blha_t)
	call connected%setup_connected_flows &
	(isolated, mask_color = mask_color)
	class default
	call connected%setup_connected_flows (isolated)
	end select
	call connected%setup_state_flv (isolated%get_n_out ())
	end subroutine setup_connected
	end subroutine term_instance_setup_event_data

	@ %def term_instance_setup_event_data
	@ Color-correlated matrix elements should be obtained from
	the external BLHA provider. According to the standard, the
	matrix elements output is a one-dimensional array. For FKS
	subtraction, we require the matrix $B_{ij}$. BLHA prescribes
	a mapping $(i, j) \to k$, where $k$ is the index of the matrix
	element in the output array. It focusses on the off-diagonal entries,
	i.e. $i \neq j$. The subroutine [[blha_color_c_fill_offdiag]] realizes
	this mapping. The diagonal entries can simply be obtained as
	the product of the Born matrix element and either $C_A$ or $C_F$,
	which is achieved by [[blha_color_c_fill_diag]].
	For simple processes, i.e. those with only one color line, it is
	$B_{ij} = C_F \cdot B$. For those, we keep the possibility of computing
	color correlations by a multiplication of the Born matrix element with $C_F$.
	It is triggered by the [[use_internal_color_correlations]] flag and should
	be used only for testing purposes. However, it is also used for
	the threshold computation where the process is well-defined and fixed.
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_color_correlations => &
	term_instance_evaluate_color_correlations
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_color_correlations (term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	end subroutine term_instance_evaluate_color_correlations
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_color_correlations (term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	integer :: i_flv_born
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	if (debug_on) call msg_debug2 (D_SUBTRACTION, &
	"term_instance_evaluate_color_correlations: " // &
	"use_internal_color_correlations:", &
	pcm%settings%use_internal_color_correlations)
	if (debug_on) call msg_debug2 (D_SUBTRACTION, "fac_scale", term%get_fac_scale ())
	do i_flv_born = 1, pcm%region_data%n_flv_born
	select case (term%nlo_type)
	case (NLO_REAL)
	call transfer_me_array_to_bij (pcm, i_flv_born, &
	pcm_work%real_sub%sqme_born (i_flv_born), &
	pcm_work%real_sub%sqme_born_color_c (:, :, i_flv_born))
	case (NLO_MISMATCH)
	call transfer_me_array_to_bij (pcm, i_flv_born, &
	pcm_work%soft_mismatch%sqme_born (i_flv_born), &
	pcm_work%soft_mismatch%sqme_born_color_c (:, :, i_flv_born))
	case (NLO_VIRTUAL)
	!!! This is just a copy of the above with a different offset and can for sure be unified
	call transfer_me_array_to_bij (pcm, i_flv_born, &
	-one, pcm_work%virtual%sqme_color_c (:, :, i_flv_born))
	case (NLO_DGLAP)
	call transfer_me_array_to_bij (pcm, i_flv_born, &
	pcm_work%dglap_remnant%sqme_born (i_flv_born), &
	pcm_work%dglap_remnant%sqme_color_c_extra (:, :, i_flv_born))
	end select
	end do
	end select
	end select
	contains
	function get_trivial_cf_factors (n_tot, flv, factorization_mode) result (beta_ij)
	integer, intent(in) :: n_tot, factorization_mode
	integer, intent(in), dimension(:) :: flv
	real(default), dimension(n_tot, n_tot) :: beta_ij
	if (factorization_mode == NO_FACTORIZATION) then
	beta_ij = get_trivial_cf_factors_default (n_tot, flv)
	else
	beta_ij = get_trivial_cf_factors_threshold (n_tot, flv)
	end if
	end function get_trivial_cf_factors

	function get_trivial_cf_factors_default (n_tot, flv) result (beta_ij)
	integer, intent(in) :: n_tot
	integer, intent(in), dimension(:) :: flv
	real(default), dimension(n_tot, n_tot) :: beta_ij
	integer :: i, j
	beta_ij = zero
	if (count (is_quark (flv)) == 2) then
	do i = 1, n_tot
	do j = 1, n_tot
	if (is_quark(flv(i)) .and. is_quark(flv(j))) then
	if (i == j) then
	beta_ij(i,j)= -cf
	else
	beta_ij(i,j) = cf
	end if
	end if
	end do
	end do
	end if
	end function get_trivial_cf_factors_default

	function get_trivial_cf_factors_threshold (n_tot, flv) result (beta_ij)
	integer, intent(in) :: n_tot
	integer, intent(in), dimension(:) :: flv
	real(default), dimension(n_tot, n_tot) :: beta_ij
	integer :: i
	beta_ij = zero
	do i = 1, 4
	beta_ij(i,i) = -cf
	end do
	beta_ij(1,2) = cf; beta_ij(2,1) = cf
	beta_ij(3,4) = cf; beta_ij(4,3) = cf
	end function get_trivial_cf_factors_threshold

	subroutine transfer_me_array_to_bij (pcm, i_flv, &
	sqme_born, sqme_color_c)
	type(pcm_nlo_t), intent(in) :: pcm
	integer, intent(in) :: i_flv
	real(default), intent(in) :: sqme_born
	real(default), dimension(:,:), intent(inout) :: sqme_color_c
	logical :: special_case_interferences
	integer :: i_color_c, i_sub, n_offset, i_qn
	real(default), dimension(:), allocatable :: sqme
	real(default) :: sqme_born_c
	if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "transfer_me_array_to_bij")
	if (pcm%settings%use_internal_color_correlations) then
	!!! A negative value for sqme_born indicates that the Born matrix
	!!! element is multiplied at a different place, e.g. in the case
	!!! of the virtual component
	sqme_color_c = get_trivial_cf_factors &
	(pcm%region_data%get_n_legs_born (), &
	pcm%region_data%get_flv_states_born (i_flv), &
	pcm%settings%factorization_mode)
	if (sqme_born > zero) then
	sqme_color_c = sqme_born * sqme_color_c
	else if (sqme_born == zero) then
	sqme_color_c = zero
	end if
	else
	special_case_interferences = &
	pcm%region_data%nlo_correction_type == "EW"
	n_offset = 0
	if (term%nlo_type == NLO_VIRTUAL) then
	n_offset = 1
	else if (pcm%has_pdfs .and. (term%is_subtraction () &
	.or. term%nlo_type == NLO_DGLAP)) then
	n_offset = n_beams_rescaled
	end if
	allocate (sqme (term%get_n_sub_color ()), source = zero)
	do i_sub = 1, term%get_n_sub_color ()
	i_qn = term%connected%trace%get_qn_index (i_flv, i_sub = i_sub + n_offset)
	if (term%passed_array(i_flv) .or. .not. term%passed) then
	sqme(i_sub) = real(term%connected%trace%get_matrix_element (i_qn), default)
	else
	sqme(i_sub) = zero
	end if
	end do
	call blha_color_c_fill_offdiag (pcm%region_data%n_legs_born, &
	sqme, sqme_color_c)
	i_qn = term%connected%trace%get_qn_index (i_flv, i_sub = 0)
	if (term%passed_array(i_flv) .or. .not. term%passed) then
	sqme_born_c = real(term%connected%trace%get_matrix_element (i_qn), default)
	else
	sqme_born_c = zero
	end if
	call blha_color_c_fill_diag (sqme_born_c, &
	pcm%region_data%get_flv_states_born (i_flv), &
	sqme_color_c, special_case_interferences)
	end if
	end subroutine transfer_me_array_to_bij
	end subroutine term_instance_evaluate_color_correlations

	@ %def term_instance_evaluate_color_correlations
	@
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_charge_correlations => &
	term_instance_evaluate_charge_correlations
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_charge_correlations (term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	end subroutine term_instance_evaluate_charge_correlations
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_charge_correlations (term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	integer :: i_flv_born
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	do i_flv_born = 1, pcm%region_data%n_flv_born
	select case (term%nlo_type)
	case (NLO_REAL)
	call transfer_me_array_to_bij (pcm, i_flv_born, &
	pcm_work%real_sub%sqme_born (i_flv_born), &
	pcm_work%real_sub%sqme_born_charge_c (:, :, i_flv_born))
	case (NLO_MISMATCH)
	call transfer_me_array_to_bij (pcm, i_flv_born, &
	pcm_work%soft_mismatch%sqme_born (i_flv_born), &
	pcm_work%soft_mismatch%sqme_born_charge_c (:, :, i_flv_born))
	case (NLO_VIRTUAL)
	call transfer_me_array_to_bij (pcm, i_flv_born, &
	one, pcm_work%virtual%sqme_charge_c (:, :, i_flv_born))
	end select
	end do
	end select
	end select
	contains
	subroutine transfer_me_array_to_bij (pcm, i_flv, sqme_born, sqme_charge_c)
	type(pcm_nlo_t), intent(in) :: pcm
	integer, intent(in) :: i_flv
	real(default), intent(in) :: sqme_born
	real(default), dimension(:,:), intent(inout) :: sqme_charge_c
	integer :: n_legs_born, i, j
	real(default), dimension(:), allocatable :: sigma
	real(default), dimension(:), allocatable :: Q
	n_legs_born = pcm%region_data%n_legs_born
	associate (flv_born => pcm%region_data%flv_born(i_flv))
	allocate (sigma (n_legs_born), Q (size (flv_born%charge)))
	Q = flv_born%charge
	sigma(1:flv_born%n_in) = -one
	sigma(flv_born%n_in + 1: ) = one
	end associate
	do i = 1, n_legs_born
	do j = 1, n_legs_born
	sqme_charge_c(i, j) = sigma(i) * sigma(j) * Q(i) * Q(j) * (-one)
	end do
	end do
	sqme_charge_c = sqme_charge_c * sqme_born
	end subroutine transfer_me_array_to_bij
	end subroutine term_instance_evaluate_charge_correlations

	@ %def term_instance_evaluate_charge_correlations
	@ The information about spin correlations is not stored in the
	[[nlo_settings]] because it is only available after the
	[[fks_regions]] have been created.
	+
	+Spin correlations have been originally foreseen for \texttt{OpenLoops}
	+as OLP; all the quantum number combinatorics is the same for another
	+BLHA-based OLP, so for \texttt{GoSam} we assume the same structure.
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_spin_correlations => &
	term_instance_evaluate_spin_correlations
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_spin_correlations (term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	end subroutine term_instance_evaluate_spin_correlations
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_spin_correlations (term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	integer :: i_flv, i_sub, i_emitter, emitter, i_qn
	integer :: n_flv, n_sub_color, n_sub_spin, n_offset,i,j
	real(default), dimension(1:3, 1:3) :: sqme_spin_c
	real(default), dimension(:), allocatable :: sqme_spin_c_all
	real(default), dimension(:), allocatable :: sqme_spin_c_arr
	if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
	"term_instance_evaluate_spin_correlations")
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	if (pcm_work%real_sub%requires_spin_correlations () &
	.and. term%nlo_type == NLO_REAL) then
	select type (core)
	- type is (prc_openloops_t)
	+ class is (prc_blha_t)
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	n_flv = term%connected%trace%get_qn_index_n_flv ()
	n_sub_color = term%get_n_sub_color ()
	n_sub_spin = term%get_n_sub_spin ()
	n_offset = 0; if(pcm%has_pdfs) n_offset = n_beams_rescaled
	allocate (sqme_spin_c_arr(6))
	do i_flv = 1, n_flv
	allocate (sqme_spin_c_all(n_sub_spin))
	do i_sub = 1, n_sub_spin
	i_qn = term%connected%trace%get_qn_index (i_flv, &
	i_sub = i_sub + n_offset + n_sub_color)
	if (term%passed_array(i_flv) .or. .not. term%passed) then
	sqme_spin_c_all(i_sub) = &
	real(term%connected%trace%get_matrix_element (i_qn), default)
	else
	sqme_spin_c_all(i_sub) = zero
	end if
	end do
	do i_emitter = 1, pcm%region_data%n_emitters
	emitter = pcm%region_data%emitters(i_emitter)
	if (emitter > 0) then
	call split_array (sqme_spin_c_all, sqme_spin_c_arr)
	do j = 1, size (sqme_spin_c, dim=2)
	do i = j, size (sqme_spin_c, dim=1)
	!!! Restoring the symmetric matrix packed into a 1-dim array
	!!! c.f. [[prc_openloops_compute_sqme_spin_c]]
	sqme_spin_c(i,j) = sqme_spin_c_arr(j + i * (i - 1) / 2)
	if (i /= j) sqme_spin_c(j,i) = sqme_spin_c(i,j)
	end do
	end do
	pcm_work%real_sub%sqme_born_spin_c(:,:,emitter,i_flv) = sqme_spin_c
	end if
	end do
	deallocate (sqme_spin_c_all)
	end do
	end select
	class default
	call msg_fatal &
	("Spin correlations so far only supported by OpenLoops.")
	end select
	end if
	end select
	end subroutine term_instance_evaluate_spin_correlations

	@ %def term_instance_evaluate_spin_correlations
	@
	<<Instances: term instance: TBP>>=
	procedure :: apply_fks => term_instance_apply_fks
	<<Instances: sub interfaces>>=
	module subroutine term_instance_apply_fks &
	(term, kin, alpha_s_sub, alpha_qed_sub)
	class(term_instance_t), intent(inout) :: term
	class(kinematics_t), intent(inout) :: kin
	real(default), intent(in) :: alpha_s_sub, alpha_qed_sub
	end subroutine term_instance_apply_fks
	<<Instances: procedures>>=
	module subroutine term_instance_apply_fks &
	(term, kin, alpha_s_sub, alpha_qed_sub)
	class(term_instance_t), intent(inout) :: term
	class(kinematics_t), intent(inout) :: kin
	real(default), intent(in) :: alpha_s_sub, alpha_qed_sub
	real(default), dimension(:), allocatable :: sqme
	integer :: i, i_phs, emitter, i_qn
	logical :: is_subtraction
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	if (term%connected%has_matrix) then
	allocate (sqme (pcm%get_n_alr ()))
	else
	allocate (sqme (1))
	end if
	sqme = zero
	select type (phs => kin%phs)
	type is (phs_fks_t)
	if (pcm%has_pdfs .and. &
	pcm%settings%use_internal_color_correlations) then
	call msg_fatal ("Color correlations for proton processes " // &
	"so far only supported by OpenLoops.")
	end if
	call pcm_work%set_real_and_isr_kinematics &
	(phs%phs_identifiers, kin%phs%get_sqrts ())
	if (kin%emitter < 0) then
	call pcm_work%set_subtraction_event ()
	do i_phs = 1, pcm%region_data%n_phs
	emitter = phs%phs_identifiers(i_phs)%emitter
	call pcm_work%real_sub%compute (emitter, &
	i_phs, alpha_s_sub, alpha_qed_sub, term%connected%has_matrix, sqme)
	end do
	else
	call pcm_work%set_radiation_event ()
	emitter = kin%emitter; i_phs = kin%i_phs
	do i = 1, term%connected%trace%get_qn_index_n_flv ()
	i_qn = term%connected%trace%get_qn_index (i)
	if (term%passed_array(i) .or. .not. term%passed) then
	pcm_work%real_sub%sqme_real_non_sub (i, i_phs) = &
	real (term%connected%trace%get_matrix_element (i_qn))
	else
	pcm_work%real_sub%sqme_real_non_sub (i, i_phs) = zero
	end if
	end do
	call pcm_work%real_sub%compute (emitter, i_phs, alpha_s_sub, &
	alpha_qed_sub, term%connected%has_matrix, sqme)
	end if
	end select
	end select
	end select
	if (term%connected%has_trace) &
	call term%connected%trace%set_only_matrix_element &
	(1, cmplx (sum(sqme), 0, default))
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	is_subtraction = kin%emitter < 0
	if (term%connected%has_matrix) &
	call refill_evaluator (cmplx (sqme * term%weight, 0, default), &
	pcm%get_qn (is_subtraction), &
	pcm%region_data%get_flavor_indices (is_subtraction), &
	term%connected%matrix)
	if (term%connected%has_flows) &
	call refill_evaluator (cmplx (sqme * term%weight, 0, default), &
	pcm%get_qn (is_subtraction), &
	pcm%region_data%get_flavor_indices (is_subtraction), &
	term%connected%flows)
	end select
	end subroutine term_instance_apply_fks

	@ %def term_instance_apply_fks
	@
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_sqme_virt => term_instance_evaluate_sqme_virt
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_sqme_virt &
	(term, alpha_s, alpha_qed)
	class(term_instance_t), intent(inout) :: term
	real(default), intent(in) :: alpha_s, alpha_qed
	end subroutine term_instance_evaluate_sqme_virt
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_sqme_virt (term, alpha_s, alpha_qed)
	class(term_instance_t), intent(inout) :: term
	real(default), intent(in) :: alpha_s, alpha_qed
	real(default), dimension(2) :: alpha_coupling
	type(vector4_t), dimension(:), allocatable :: p_born
	real(default), dimension(:), allocatable :: sqme_virt
	integer :: i_flv, i_qn_born, i_qn_virt
	if (term%nlo_type /= NLO_VIRTUAL) call msg_fatal ("Trying to " // &
	"evaluate virtual matrix element with unsuited term_instance.")
	if (debug2_active (D_VIRTUAL)) then
	call msg_debug2 &
	(D_VIRTUAL, "Evaluating virtual-subtracted matrix elements")
	print *, 'ren_scale: ', term%get_ren_scale ()
	print *, 'fac_scale: ', term%get_fac_scale ()
	if (allocated (term%es_scale)) then
	print *, 'ES scale: ', term%es_scale
	else
	print *, 'ES scale: ', term%get_ren_scale ()
	end if
	end if
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	alpha_coupling = [alpha_s, alpha_qed]
	if (debug2_active (D_VIRTUAL)) then
	print *, 'alpha_s: ', alpha_coupling (1)
	print *, 'alpha_qed: ', alpha_coupling (2)
	end if
	allocate (p_born (pcm%region_data%n_legs_born))
	if (pcm%settings%factorization_mode == FACTORIZATION_THRESHOLD) then
	p_born = pcm_work%real_kinematics%p_born_onshell%get_momenta(1)
	else
	p_born = term%int_hard%get_momenta ()
	end if
	call pcm_work%set_momenta_and_scales_virtual &
	(p_born, term%ren_scale, term%get_fac_scale (), &
	term%es_scale)
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	associate (virtual => pcm_work%virtual)
	do i_flv = 1, term%connected%trace%get_qn_index_n_flv ()
	i_qn_born = term%connected%trace%get_qn_index (i_flv, i_sub = 0)
	i_qn_virt = term%connected%trace%get_qn_index (i_flv, i_sub = 1)
	if (term%passed_array(i_flv) .or. .not. term%passed) then
	virtual%sqme_born(i_flv) = &
	real (term%connected%trace%get_matrix_element (i_qn_born))
	virtual%sqme_virt_fin(i_flv) = &
	real (term%connected%trace%get_matrix_element (i_qn_virt))
	else
	virtual%sqme_born(i_flv) = zero
	virtual%sqme_virt_fin(i_flv) = zero
	end if
	end do
	end associate
	end select
	call pcm_work%compute_sqme_virt (term%pcm, term%p_hard, &
	alpha_coupling, term%connected%has_matrix, sqme_virt)
	call term%connected%trace%set_only_matrix_element &
	(1, cmplx (sum(sqme_virt), 0, default))
	if (term%connected%has_matrix) &
	call refill_evaluator (cmplx (sqme_virt * term%weight, &
	0, default), pcm%get_qn (.true.), &
	remove_duplicates_from_int_array ( &
	pcm%region_data%get_flavor_indices (.true.)), &
	term%connected%matrix)
	if (term%connected%has_flows) &
	call refill_evaluator (cmplx (sqme_virt * term%weight, &
	0, default), pcm%get_qn (.true.), &
	remove_duplicates_from_int_array ( &
	pcm%region_data%get_flavor_indices (.true.)), &
	term%connected%flows)
	end select
	end select
	end subroutine term_instance_evaluate_sqme_virt

	@ %def term_instance_evaluate_sqme_virt
	@ Needs generalization to electroweak corrections.
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_sqme_mismatch => term_instance_evaluate_sqme_mismatch
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_sqme_mismatch (term, alpha_s)
	class(term_instance_t), intent(inout) :: term
	real(default), intent(in) :: alpha_s
	end subroutine term_instance_evaluate_sqme_mismatch
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_sqme_mismatch (term, alpha_s)
	class(term_instance_t), intent(inout) :: term
	real(default), intent(in) :: alpha_s
	real(default), dimension(:), allocatable :: sqme_mism
	if (term%nlo_type /= NLO_MISMATCH) call msg_fatal &
	("Trying to evaluate soft mismatch with unsuited term_instance.")
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	call pcm_work%compute_sqme_mismatch &
	(term%pcm, alpha_s, term%connected%has_matrix, sqme_mism)
	end select
	call term%connected%trace%set_only_matrix_element &
	(1, cmplx (sum (sqme_mism) * term%weight, 0, default))
	if (term%connected%has_matrix) then
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	if (term%connected%has_matrix) &
	call refill_evaluator (cmplx (sqme_mism * term%weight, 0, default), &
	pcm%get_qn (.true.), &
	remove_duplicates_from_int_array ( &
	pcm%region_data%get_flavor_indices (.true.)), &
	term%connected%matrix)
	if (term%connected%has_flows) &
	call refill_evaluator (cmplx (sqme_mism * term%weight, 0, default), &
	pcm%get_qn (.true.), &
	remove_duplicates_from_int_array ( &
	pcm%region_data%get_flavor_indices (.true.)), &
	term%connected%flows)
	end select
	end if
	end subroutine term_instance_evaluate_sqme_mismatch

	@ %def term_instance_evaluate_sqme_mismatch
	@
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_sqme_dglap => term_instance_evaluate_sqme_dglap
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_sqme_dglap &
	(term, alpha_s, alpha_qed)
	class(term_instance_t), intent(inout) :: term
	real(default), intent(in) :: alpha_s, alpha_qed
	end subroutine term_instance_evaluate_sqme_dglap
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_sqme_dglap (term, alpha_s, alpha_qed)
	class(term_instance_t), intent(inout) :: term
	real(default), intent(in) :: alpha_s, alpha_qed
	real(default), dimension(2) :: alpha_coupling
	real(default), dimension(:), allocatable :: sqme_dglap
	integer :: i_flv
	if (term%nlo_type /= NLO_DGLAP) call msg_fatal &
	("Trying to evaluate DGLAP remnant with unsuited term_instance.")
	if (debug_on) call msg_debug2 &
	(D_PROCESS_INTEGRATION, "term_instance_evaluate_sqme_dglap")
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	alpha_coupling = [alpha_s,alpha_qed]
	if (debug2_active (D_PROCESS_INTEGRATION)) then
	associate (n_flv => pcm_work%dglap_remnant%reg_data%n_flv_born)
	print *, "size(sqme_born) = ", &
	size (pcm_work%dglap_remnant%sqme_born)
	call term%connected%trace%write ()
	end associate
	end if
	call pcm_work%compute_sqme_dglap_remnant (pcm, alpha_coupling, &
	term%connected%has_matrix, sqme_dglap)
	end select
	end select
	call term%connected%trace%set_only_matrix_element &
	(1, cmplx (sum (sqme_dglap) * term%weight, 0, default))
	if (term%connected%has_matrix) then
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	call refill_evaluator (cmplx (sqme_dglap * term%weight, 0, default), &
	pcm%get_qn (.true.), &
	remove_duplicates_from_int_array ( &
	pcm%region_data%get_flavor_indices (.true.)), &
	term%connected%matrix)
	if (term%connected%has_flows) then
	call refill_evaluator &
	(cmplx (sqme_dglap * term%weight, 0, default), &
	pcm%get_qn (.true.), &
	remove_duplicates_from_int_array ( &
	pcm%region_data%get_flavor_indices (.true.)), &
	term%connected%flows)
	end if
	end select
	end if
	end subroutine term_instance_evaluate_sqme_dglap

	@ %def term_instance_evaluate_sqme_dglap
	@ Reset the term instance: clear the parton-state expressions and deactivate.
	<<Instances: term instance: TBP>>=
	procedure :: reset => term_instance_reset
	<<Instances: sub interfaces>>=
	module subroutine term_instance_reset (term)
	class(term_instance_t), intent(inout) :: term
	end subroutine term_instance_reset
	<<Instances: procedures>>=
	module subroutine term_instance_reset (term)
	class(term_instance_t), intent(inout) :: term
	call term%connected%reset_expressions ()
	if (allocated (term%alpha_qcd_forced)) deallocate (term%alpha_qcd_forced)
	term%active = .false.
	end subroutine term_instance_reset

	@ %def term_instance_reset
	@ Force an $\alpha_s$ value that should be used in the matrix-element
	calculation.
	<<Instances: term instance: TBP>>=
	procedure :: set_alpha_qcd_forced => term_instance_set_alpha_qcd_forced
	<<Instances: sub interfaces>>=
	module subroutine term_instance_set_alpha_qcd_forced (term, alpha_qcd)
	class(term_instance_t), intent(inout) :: term
	real(default), intent(in) :: alpha_qcd
	end subroutine term_instance_set_alpha_qcd_forced
	<<Instances: procedures>>=
	module subroutine term_instance_set_alpha_qcd_forced (term, alpha_qcd)
	class(term_instance_t), intent(inout) :: term
	real(default), intent(in) :: alpha_qcd
	if (allocated (term%alpha_qcd_forced)) then
	term%alpha_qcd_forced = alpha_qcd
	else
	allocate (term%alpha_qcd_forced, source = alpha_qcd)
	end if
	end subroutine term_instance_set_alpha_qcd_forced

	@ %def term_instance_set_alpha_qcd_forced
	@ Complete the kinematics computation for the effective parton states.

	We assume that the [[compute_hard_kinematics]] method of the process
	component instance has already been called, so the [[int_hard]]
	contains the correct hard kinematics. The duty of this procedure is
	first to compute the effective kinematics and store this in the
	[[int_eff]] effective interaction inside the [[isolated]] parton
	state. The effective kinematics may differ from the kinematics in the hard
	interaction. It may involve parton recombination or parton splitting.
	The [[rearrange_partons]] method is responsible for this part.

	We may also call a method to compute the effective structure-function
	chain at this point. This is not implemented yet.

	In the simple case that no rearrangement is necessary, as indicated by
	the [[rearrange]] flag, the effective interaction is a pointer to the
	hard interaction, and we can skip the rearrangement method. Similarly
	for the effective structure-function chain.

	The final step of kinematics setup is to transfer the effective
	kinematics to the evaluators and to the [[subevt]].
	<<Instances: term instance: TBP>>=
	procedure :: compute_eff_kinematics => &
	term_instance_compute_eff_kinematics
	<<Instances: sub interfaces>>=
	module subroutine term_instance_compute_eff_kinematics (term)
	class(term_instance_t), intent(inout) :: term
	end subroutine term_instance_compute_eff_kinematics
	<<Instances: procedures>>=
	module subroutine term_instance_compute_eff_kinematics (term)
	class(term_instance_t), intent(inout) :: term
	term%checked = .false.
	term%passed = .false.
	call term%isolated%receive_kinematics ()
	call term%connected%receive_kinematics ()
	end subroutine term_instance_compute_eff_kinematics

	@ %def term_instance_compute_eff_kinematics
	@ Inverse. Reconstruct the connected state from the momenta in the
	trace evaluator (which we assume to be set), then reconstruct the
	isolated state as far as possible. The second part finalizes the
	momentum configuration, using the incoming seed momenta
	<<Instances: term instance: TBP>>=
	procedure :: recover_hard_kinematics => &
	term_instance_recover_hard_kinematics
	<<Instances: sub interfaces>>=
	module subroutine term_instance_recover_hard_kinematics (term)
	class(term_instance_t), intent(inout) :: term
	end subroutine term_instance_recover_hard_kinematics
	<<Instances: procedures>>=
	module subroutine term_instance_recover_hard_kinematics (term)
	class(term_instance_t), intent(inout) :: term
	term%checked = .false.
	term%passed = .false.
	call term%connected%send_kinematics ()
	call term%isolated%send_kinematics ()
	end subroutine term_instance_recover_hard_kinematics

	@ %def term_instance_recover_hard_kinematics
	@ Check the term whether it passes cuts and, if successful, evaluate
	scales and weights. The factorization scale is also given to the term
	kinematics, enabling structure-function evaluation.
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_expressions => &
	term_instance_evaluate_expressions
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_expressions &
	(term, config, scale_forced)
	class(term_instance_t), intent(inout) :: term
	type(process_beam_config_t), intent(in) :: config
	real(default), intent(in), allocatable, optional :: scale_forced
	end subroutine term_instance_evaluate_expressions
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_expressions &
	(term, config, scale_forced)
	class(term_instance_t), intent(inout) :: term
	type(process_beam_config_t), intent(in) :: config
	real(default), intent(in), allocatable, optional :: scale_forced
	real(default) :: scale = 0
	real(default) :: weight = 1
	real(default), allocatable :: fac_scale, ren_scale
	type(interaction_t), pointer :: src_int
	type(state_matrix_t), pointer :: state_matrix
	type(flavor_t), dimension(:), allocatable :: flv_int, flv_src, f_in, f_out
	logical :: passed
	integer :: n_in, n_vir, n_out, n_tot, n_flv
	integer :: i, j, k
	n_flv = term%connected%trace%get_qn_index_n_flv ()
	if (.not. allocated (term%passed_array)) allocate (term%passed_array(n_flv))
	if (term%flv_dep_cut_eval) then
	do k = 1, n_flv
	if (k == term%i_flv_to_i_flv_rep(k)) then
	n_in = term%int_hard%get_n_in ()
	associate (int_eff => term%isolated%int_eff)
	state_matrix => int_eff%get_state_matrix_ptr ()
	n_tot = int_eff%get_n_tot ()
	flv_int = quantum_numbers_get_flavor &
	(state_matrix%get_quantum_number (k))
	allocate (f_in (n_in))
	f_in = flv_int(1:n_in)
	deallocate (flv_int)
	end associate
	n_in = term%connected%trace%get_n_in ()
	n_vir = term%connected%trace%get_n_vir ()
	n_out = term%connected%trace%get_n_out ()
	allocate (f_out (n_out))
	do j = 1, n_out
	call term%connected%trace%find_source &
	(n_in + n_vir + j, src_int, i)
	if (associated (src_int)) then
	state_matrix => src_int%get_state_matrix_ptr ()
	flv_src = quantum_numbers_get_flavor &
	(state_matrix%get_quantum_number (k))
	f_out(j) = flv_src(i)
	deallocate (flv_src)
	end if
	end do

	call term%connected%renew_flv_content_subevt &
	(term%isolated%sf_chain_eff, &
	config%data%flv, f_in, f_out)
	call term%connected%evaluate_expressions (passed, &
	scale, fac_scale, ren_scale, weight, &
	scale_forced, force_evaluation = .true.)
	if (k == 1) then
	term%scale = scale
	if (allocated (fac_scale)) then
	if (.not. allocated (term%fac_scale)) then
	allocate (term%fac_scale, source = fac_scale)
	else
	term%fac_scale = fac_scale
	end if
	end if
	if (allocated (ren_scale)) then
	if (.not. allocated (term%ren_scale)) then
	allocate (term%ren_scale, source = ren_scale)
	else
	term%ren_scale = ren_scale
	end if
	end if
	term%weight = weight
	end if
	term%passed_array(k) = passed
	deallocate (f_in)
	deallocate (f_out)
	else
	term%passed_array(k) = term%passed_array(term%i_flv_to_i_flv_rep(k))
	end if
	end do
	term%passed = any (term%passed_array)
	else
	call term%connected%evaluate_expressions (term%passed, &
	term%scale, term%fac_scale, term%ren_scale, term%weight, &
	scale_forced, force_evaluation = .true.)
	term%passed_array = term%passed
	end if
	term%checked = .true.
	end subroutine term_instance_evaluate_expressions

	@ %def term_instance_evaluate_expressions
	@ Evaluate the trace: first evaluate the hard interaction, then the trace
	evaluator. We use the [[evaluate_interaction]] method of the process
	component which generated this term. The [[subevt]] and cut expressions are
	not yet filled.

	The [[component]] argument is intent(inout) because the [[compute_amplitude]]
	method may modify the [[core_state]] workspace object.
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_interaction => term_instance_evaluate_interaction
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_interaction (term, core, kin)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(in), pointer :: core
	type(kinematics_t), intent(inout) :: kin
	end subroutine term_instance_evaluate_interaction
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_interaction (term, core, kin)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(in), pointer :: core
	type(kinematics_t), intent(inout) :: kin
	if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
	"term_instance_evaluate_interaction")
	if (kin%only_cm_frame .and. (.not. kin%lab_is_cm())) then
	term%p_hard = kin%get_boost_to_cms () * term%int_hard%get_momenta ()
	else
	term%p_hard = term%int_hard%get_momenta ()
	end if
	select type (core)
	class is (prc_external_t)
	call term%evaluate_interaction_external (core, kin)
	class default
	call term%evaluate_interaction_default (core)
	end select
	call term%int_hard%set_matrix_element (term%amp)
	end subroutine term_instance_evaluate_interaction

	@ %def term_instance_evaluate_interaction
	@
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_interaction_default &
	=> term_instance_evaluate_interaction_default
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_interaction_default (term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(in) :: core
	end subroutine term_instance_evaluate_interaction_default
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_interaction_default (term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(in) :: core
	real(default) :: fac_scale, ren_scale
	integer :: i
	if (allocated (term%fac_scale)) then
	fac_scale = term%fac_scale
	else
	fac_scale = term%scale
	end if
	if (allocated (term%ren_scale)) then
	ren_scale = term%ren_scale
	else
	ren_scale = term%scale
	end if
	do i = 1, term%config%n_allowed
	term%amp(i) = core%compute_amplitude (term%config%i_term, term%p_hard, &
	term%config%flv(i), term%config%hel(i), term%config%col(i), &
	fac_scale, ren_scale, term%alpha_qcd_forced, &
	term%core_state)
	end do
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	call pcm_work%set_fac_scale (fac_scale)
	end select
	end subroutine term_instance_evaluate_interaction_default

	@ %def term_instance_evaluate_interaction_default
	@
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_interaction_external &
	=> term_instance_evaluate_interaction_external
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_interaction_external &
	(term, core, kin)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	type(kinematics_t), intent(inout) :: kin
	end subroutine term_instance_evaluate_interaction_external
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_interaction_external &
	(term, core, kin)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	type(kinematics_t), intent(inout) :: kin
	if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
	"term_instance_evaluate_interaction_external")
	select type (core_state => term%core_state)
	type is (openloops_state_t)
	select type (core)
	type is (prc_openloops_t)
	call core%compute_alpha_s (core_state, term%get_ren_scale ())
	if (allocated (core_state%threshold_data)) &
	call evaluate_threshold_parameters (core_state, core, kin%phs%get_sqrts ())
	end select
	class is (prc_external_state_t)
	select type (core)
	class is (prc_external_t)
	call core%compute_alpha_s (core_state, term%get_ren_scale ())
	end select
	end select
	call evaluate_threshold_interaction ()
	if (term%nlo_type == NLO_VIRTUAL) then
	call term%evaluate_interaction_external_loop (core)
	else
	call term%evaluate_interaction_external_tree (core)
	end if
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	call pcm_work%set_fac_scale (term%get_fac_scale ())
	end select

	contains
	subroutine evaluate_threshold_parameters (core_state, core, sqrts)
	type(openloops_state_t), intent(inout) :: core_state
	type(prc_openloops_t), intent(inout) :: core
	real(default), intent(in) :: sqrts
	real(default) :: mtop, wtop
	mtop = m1s_to_mpole (sqrts)
	wtop = core_state%threshold_data%compute_top_width &
	(mtop, core_state%alpha_qcd)
	call core%set_mass_and_width (6, mtop, wtop)
	end subroutine

	subroutine evaluate_threshold_interaction ()
	integer :: leg
	select type (core)
	type is (prc_threshold_t)
	if (term%nlo_type > BORN) then
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	if (kin%emitter >= 0) then
	call core%set_offshell_momenta &
	(pcm_work%real_kinematics%p_real_cms%get_momenta(term%config%i_term))
	leg = thr_leg (kin%emitter)
	call core%set_leg (leg)
	call core%set_onshell_momenta &
	(pcm_work%real_kinematics%p_real_onshell(leg)%get_momenta(term%config%i_term))
	else
	call core%set_leg (0)
	call core%set_offshell_momenta &
	(pcm_work%real_kinematics%p_born_cms%get_momenta(1))
	end if
	end select
	else
	call core%set_leg (-1)
	call core%set_offshell_momenta (term%p_hard)
	end if
	end select
	end subroutine evaluate_threshold_interaction
	end subroutine term_instance_evaluate_interaction_external

	@ %def term_instance_evaluate_interaction_external
	@ Retrieve the matrix elements from a matrix element provider and place them
	into [[term%amp]].

	For the handling of NLO calculations, FKS applies a book keeping handling
	flavor and/or particle type (e.g. for QCD: quark/gluon and quark flavor) in
	order to calculate the subtraction terms. Therefore, we have to insert the
	calculated matrix elements correctly into the state matrix where each entry
	corresponds to a set of quantum numbers. We apply a mapping
	[[hard_qn_ind]] from a list of quantum numbers provided by FKS to the
	hard process [[int_hard]].

	The calculated matrix elements are insert into [[term%amp]] in the following
	way. The first [[n_born]] particles are the matrix element of the hard process.
	In non-trivial beams, we store another [[n_beams_rescaled]] copies of these
	matrix elements as the first [[n_beams_rescaled]] subtractions. This
	is a remnant from times before the method
	[[term_instance_set_sf_factors]] and these entries are not used
	anymore. However, eliminating these entries involves deeper changes in
	how the connection tables for the evaluator product are set up and
	should therefore be part of a larger refactoring of the interactions
	\& state matrices. The next $n_{\text{born}}\times n_{sub_color}$ are
	color-correlated Born matrix elements, with then again the next
	$n_{\text{born}}\times n_{emitters}\times n_{sub_spin}$ being
	spin-correlated Born matrix elements.

	If two or more flavor structures would produce the same amplitude we
	only compute one and use the [[eqv_index]] determined by the
	[[prc_core]] and just copy the result to improve performance.
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_interaction_external_tree &
	=> term_instance_evaluate_interaction_external_tree
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_interaction_external_tree &
	(term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	end subroutine term_instance_evaluate_interaction_external_tree
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_interaction_external_tree &
	(term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(inout) :: core
	real(default) :: sqme
	real(default), dimension(:), allocatable :: sqme_color_c
	real(default), dimension(:), allocatable :: sqme_spin_c
	real(default), dimension(6) :: sqme_spin_c_tmp
	+ real(default), dimension(OLP_RESULTS_LIMIT) :: sqme_spin_c_gosam
	integer :: n_flv, n_hel, n_sub_color, n_sub_spin, n_pdf_off
	integer :: i_flv, i_hel, i_sub, i_color_c, i_color_c_eqv, &
	i_spin_c, i_spin_c_eqv
	integer :: i_flv_eqv, i_hel_eqv
	integer :: emitter, i_emitter
	+ integer :: idl, idh
	logical :: bad_point, bp
	logical, dimension(:,:), allocatable :: eqv_me_evaluated
	if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, &
	"term_instance_evaluate_interaction_external_tree")
	allocate (sqme_color_c (blha_result_array_size &
	(term%int_hard%get_n_tot (), BLHA_AMP_COLOR_C)))
	n_flv = term%int_hard%get_qn_index_n_flv ()
	n_hel = term%int_hard%get_qn_index_n_hel ()
	n_sub_color = term%get_n_sub_color ()
	n_sub_spin = term%get_n_sub_spin ()
	allocate (eqv_me_evaluated(n_flv,n_hel))
	eqv_me_evaluated = .false.
	do i_flv = 1, n_flv
	if (.not. term%passed_array(i_flv) .and. term%passed) cycle
	do i_hel = 1, n_hel
	i_flv_eqv = core%data%eqv_flv_index(i_flv)
	i_hel_eqv = core%data%eqv_hel_index(i_hel)
	if (.not. eqv_me_evaluated(i_flv_eqv, i_hel_eqv)) then
	select type (core)
	class is (prc_external_t)
	call core%update_alpha_s (term%core_state, term%get_ren_scale ())
	call core%compute_sqme (i_flv, i_hel, term%p_hard, &
	term%get_ren_scale (), sqme, bad_point)
	call term%pcm_work%set_bad_point (bad_point)
	associate (i_int => term%int_hard%get_qn_index &
	(i_flv = i_flv, i_hel = i_hel, i_sub = 0))
	term%amp(i_int) = cmplx (sqme, 0, default)
	end associate
	end select
	n_pdf_off = 0
	if (term%pcm%has_pdfs .and. &
	(term%is_subtraction () .or. term%nlo_type == NLO_DGLAP)) then
	n_pdf_off = n_pdf_off + n_beams_rescaled
	do i_sub = 1, n_pdf_off
	term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub)) = &
	term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub = 0))
	end do
	end if
	if (term%pcm%has_pdfs .and. term%nlo_type == NLO_DGLAP) then
	sqme_color_c = zero
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	if (pcm%settings%nlo_correction_type == "EW" .and. &
	pcm%region_data%alphas_power > 0) then
	select type (core)
	class is (prc_blha_t)
	call core%compute_sqme_color_c_raw (i_flv, i_hel, &
	term%p_hard, term%get_ren_scale (), sqme_color_c, &
	bad_point)
	call term%pcm_work%set_bad_point (bad_point)
	class is (prc_recola_t)
	call core%compute_sqme_color_c_raw (i_flv, i_hel, &
	term%p_hard, term%get_ren_scale (), sqme_color_c, &
	bad_point)
	call term%pcm_work%set_bad_point (bad_point)
	end select
	end if
	end select
	do i_sub = 1, n_sub_color
	i_color_c = term%int_hard%get_qn_index &
	(i_flv, i_hel, i_sub + n_pdf_off)
	term%amp(i_color_c) = cmplx (sqme_color_c(i_sub), 0, default)
	end do
	end if
	if ((term%nlo_type == NLO_REAL .and. term%is_subtraction ()) .or. &
	term%nlo_type == NLO_MISMATCH) then
	sqme_color_c = zero
	select type (core)
	class is (prc_blha_t)
	call core%compute_sqme_color_c_raw (i_flv, i_hel, &
	term%p_hard, term%get_ren_scale (), sqme_color_c, bad_point)
	call term%pcm_work%set_bad_point (bad_point)
	class is (prc_recola_t)
	call core%compute_sqme_color_c_raw (i_flv, i_hel, &
	term%p_hard, term%get_ren_scale (), sqme_color_c, bad_point)
	call term%pcm_work%set_bad_point (bad_point)
	end select
	do i_sub = 1, n_sub_color
	i_color_c = term%int_hard%get_qn_index &
	(i_flv, i_hel, i_sub + n_pdf_off)
	term%amp(i_color_c) = cmplx (sqme_color_c(i_sub), 0, default)
	end do
	if (n_sub_spin > 0) then
	bad_point = .false.
	allocate (sqme_spin_c(0))
	select type (core)
	type is (prc_openloops_t)
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	do i_emitter = 1, pcm%region_data%n_emitters
	emitter = pcm%region_data%emitters(i_emitter)
	if (emitter > 0) then
	call core%compute_sqme_spin_c &
	(i_flv, &
	i_hel, &
	emitter, &
	term%p_hard, &
	term%get_ren_scale (), &
	sqme_spin_c_tmp, &
	bp)
	sqme_spin_c = [sqme_spin_c, sqme_spin_c_tmp]
	bad_point = bad_point .or. bp
	end if
	end do
	end select
	do i_sub = 1, n_sub_spin
	i_spin_c = term%int_hard%get_qn_index (i_flv, i_hel, &
	i_sub + n_pdf_off + n_sub_color)
	term%amp(i_spin_c) = cmplx &
	(sqme_spin_c(i_sub), 0, default)
	end do
	+ type is (prc_gosam_t)
	+ select type (pcm => term%pcm)
	+ type is (pcm_nlo_t)
	+ call core%compute_sqme_spin_c &
	+ (i_flv, &
	+ i_hel, &
	+ term%p_hard, &
	+ term%get_ren_scale (), &
	+ sqme_spin_c_gosam, &
	+ bp)
	+ do i_emitter = 1, pcm%region_data%n_emitters
	+ emitter = pcm%region_data%emitters(i_emitter)
	+ if (emitter > 0) then
	+ idl = 6*(emitter-1)+1
	+ idh = 6*(emitter-1)+6
	+ sqme_spin_c = [sqme_spin_c, sqme_spin_c_gosam(idl:idh)]
	+ bad_point = bad_point .or. bp
	+ end if
	+ end do
	+ end select
	+ do i_sub = 1, n_sub_spin
	+ i_spin_c = term%int_hard%get_qn_index (i_flv, i_hel, &
	+ i_sub + n_pdf_off + n_sub_color)
	+ term%amp(i_spin_c) = cmplx &
	+ (sqme_spin_c(i_sub), 0, default)
	+ end do
	end select
	deallocate (sqme_spin_c)
	end if
	end if
	eqv_me_evaluated(i_flv_eqv, i_hel_eqv) = .true.
	else
	associate (i_int => term%int_hard%get_qn_index &
	(i_flv = i_flv, i_hel = i_hel, i_sub = 0), &
	i_int_eqv => term%int_hard%get_qn_index &
	(i_flv = i_flv_eqv, i_hel = i_hel_eqv, i_sub = 0))
	term%amp(i_int) = term%amp(i_int_eqv)
	end associate
	n_pdf_off = 0
	if (term%pcm%has_pdfs .and. &
	(term%is_subtraction () .or. term%nlo_type == NLO_DGLAP)) then
	n_pdf_off = n_pdf_off + n_beams_rescaled
	do i_sub = 1, n_pdf_off
	term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub)) = &
	term%amp(term%int_hard%get_qn_index (i_flv, i_hel, i_sub = 0))
	end do
	end if
	if (term%pcm%has_pdfs .and. term%nlo_type == NLO_DGLAP) then
	do i_sub = 1, n_sub_color
	i_color_c = term%int_hard%get_qn_index &
	(i_flv, i_hel, i_sub + n_pdf_off)
	i_color_c_eqv = term%int_hard%get_qn_index &
	(i_flv_eqv, i_hel_eqv, i_sub + n_pdf_off)
	term%amp(i_color_c) = term%amp(i_color_c_eqv)
	end do
	end if
	if ((term%nlo_type == NLO_REAL .and. term%is_subtraction ()) .or. &
	term%nlo_type == NLO_MISMATCH) then
	do i_sub = 1, n_sub_color
	i_color_c = term%int_hard%get_qn_index &
	(i_flv, i_hel, i_sub + n_pdf_off)
	i_color_c_eqv = term%int_hard%get_qn_index &
	(i_flv_eqv, i_hel_eqv, i_sub + n_pdf_off)
	term%amp(i_color_c) = term%amp(i_color_c_eqv)
	end do
	do i_sub = 1, n_sub_spin
	i_spin_c = term%int_hard%get_qn_index (i_flv, i_hel, &
	i_sub + n_pdf_off + n_sub_color)
	i_spin_c_eqv = term%int_hard%get_qn_index (i_flv_eqv, i_hel_eqv, &
	i_sub + n_pdf_off + n_sub_color)
	term%amp(i_spin_c) = term%amp(i_spin_c_eqv)
	end do
	end if
	end if
	end do
	end do
	end subroutine term_instance_evaluate_interaction_external_tree

	@ %def term_instance_evaluate_interaction_external_tree
	@ Same as for [[term_instance_evaluate_interaction_external_tree]], but
	for the integrated-subtraction and finite one-loop terms. We only need
	color-correlated Born matrix elements, but an additional entry per
	flavor structure for the finite one-loop contribution. We thus have
	$2+n_{sub_color}$ entries in the [[term%amp]] for each [[i_flv]] and
	[[i_hel]] combination.

	If two or more flavor structures would produce the same amplitude we
	only compute one and use the [[eqv_index]] determined by the
	[[prc_core]] and just copy the result to improve performance.
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_interaction_external_loop &
	=> term_instance_evaluate_interaction_external_loop
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_interaction_external_loop &
	(term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(in) :: core
	end subroutine term_instance_evaluate_interaction_external_loop
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_interaction_external_loop &
	(term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(in) :: core
	integer :: n_hel, n_sub, n_flv
	integer :: i, i_flv, i_hel, i_sub, i_virt, i_color_c, i_color_c_eqv
	integer :: i_flv_eqv, i_hel_eqv
	real(default), dimension(4) :: sqme_virt
	real(default), dimension(:), allocatable :: sqme_color_c
	real(default) :: es_scale
	logical :: bad_point
	logical, dimension(:,:), allocatable :: eqv_me_evaluated
	if (debug_on) call msg_debug (D_PROCESS_INTEGRATION, &
	"term_instance_evaluate_interaction_external_loop")
	allocate (sqme_color_c (blha_result_array_size &
	(term%int_hard%get_n_tot (), BLHA_AMP_COLOR_C)))
	n_flv = term%int_hard%get_qn_index_n_flv ()
	n_hel = term%int_hard%get_qn_index_n_hel ()
	n_sub = term%int_hard%get_qn_index_n_sub ()
	allocate (eqv_me_evaluated(n_flv,n_hel))
	eqv_me_evaluated = .false.
	i_virt = 1
	do i_flv = 1, n_flv
	if (.not. term%passed_array(i_flv) .and. term%passed) cycle
	do i_hel = 1, n_hel
	i_flv_eqv = core%data%eqv_flv_index(i_flv)
	i_hel_eqv = core%data%eqv_hel_index(i_hel)
	if (.not. eqv_me_evaluated(i_flv_eqv, i_hel_eqv)) then
	select type (core)
	class is (prc_external_t)
	if (allocated (term%es_scale)) then
	es_scale = term%es_scale
	else
	es_scale = term%get_ren_scale ()
	end if
	call core%compute_sqme_virt (i_flv, i_hel, term%p_hard, &
	term%get_ren_scale (), es_scale, &
	term%pcm%blha_defaults%loop_method, &
	sqme_virt, bad_point)
	call term%pcm_work%set_bad_point (bad_point)
	end select
	associate (i_born => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = 0), &
	i_loop => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = i_virt))
	term%amp(i_loop) = cmplx (sqme_virt(3), 0, default)
	term%amp(i_born) = cmplx (sqme_virt(4), 0, default)
	end associate
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	select type (core)
	class is (prc_blha_t)
	call core%compute_sqme_color_c_raw (i_flv, i_hel, &
	term%p_hard, term%get_ren_scale (), &
	sqme_color_c, bad_point)
	call term%pcm_work%set_bad_point (bad_point)
	do i_sub = 1 + i_virt, n_sub
	i_color_c = term%int_hard%get_qn_index &
	(i_flv, i_hel = i_hel, i_sub = i_sub)
	! Index shift: i_sub - i_virt
	term%amp(i_color_c) = &
	cmplx (sqme_color_c(i_sub - i_virt), 0, default)
	end do
	type is (prc_recola_t)
	call core%compute_sqme_color_c_raw (i_flv, i_hel, &
	term%p_hard, term%get_ren_scale (), sqme_color_c, bad_point)
	call term%pcm_work%set_bad_point (bad_point)
	do i_sub = 1 + i_virt, n_sub
	i_color_c = term%int_hard%get_qn_index &
	(i_flv, i_hel = i_hel, i_sub = i_sub)
	! Index shift: i_sub - i_virt
	term%amp(i_color_c) = &
	cmplx (sqme_color_c(i_sub - i_virt), 0, default)
	end do
	end select
	end select
	eqv_me_evaluated(i_flv_eqv, i_hel_eqv) = .true.
	else
	associate (i_born => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = 0), &
	i_loop => term%int_hard%get_qn_index (i_flv, i_hel = i_hel, i_sub = i_virt), &
	i_born_eqv => term%int_hard%get_qn_index &
	(i_flv_eqv, i_hel = i_hel_eqv, i_sub = 0), &
	i_loop_eqv => term%int_hard%get_qn_index &
	(i_flv_eqv, i_hel = i_hel_eqv, i_sub = 1))
	term%amp(i_loop) = term%amp(i_loop_eqv)
	term%amp(i_born) = term%amp(i_born_eqv)
	end associate
	do i_sub = 1 + i_virt, n_sub
	i_color_c = term%int_hard%get_qn_index &
	(i_flv, i_hel = i_hel, i_sub = i_sub)
	i_color_c_eqv = term%int_hard%get_qn_index &
	(i_flv_eqv, i_hel = i_hel_eqv, i_sub = i_sub)
	! Index shift: i_sub - i_virt
	term%amp(i_color_c) = term%amp(i_color_c_eqv)
	end do
	end if
	end do
	end do
	end subroutine term_instance_evaluate_interaction_external_loop

	@ %def term_instance_evaluate_interaction_external_loop
	@ Evaluate the trace. First evaluate the
	structure-function chain (i.e., the density matrix of the incoming
	partons). Do this twice, in case the sf-chain instances within
	[[kin]] and [[isolated]] differ. Next, evaluate the hard
	interaction, then compute the convolution with the initial state.
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_trace => term_instance_evaluate_trace
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_trace (term, kin)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(inout) :: kin
	end subroutine term_instance_evaluate_trace
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_trace (term, kin)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(inout) :: kin
	real(default) :: fac_scale
	if (allocated (term%fac_scale)) then
	fac_scale = term%fac_scale
	else
	fac_scale = term%scale
	end if
	call kin%evaluate_sf_chain (fac_scale, term%negative_sf)
	call term%evaluate_scaled_sf_chains (kin)
	call term%isolated%evaluate_sf_chain (fac_scale)
	call term%isolated%evaluate_trace ()
	call term%connected%evaluate_trace ()
	end subroutine term_instance_evaluate_trace

	@ %def term_instance_evaluate_trace
	@ Include rescaled structure functions due to NLO calculation. We
	rescale the structure function for the real subtraction
	[[sf_rescale_collinear]], the collinear counter terms
	[[sf_rescale_dglap_t]] and for the case, in which we have an emitter
	in the initial state, we rescale the kinematics for it using
	[[sf_rescale_real_t]]. The references are arXiv:0709.2092,
	Eqs.~(2.35)-(2.42).

	Obviously, it is completely irrelevant, which beam is treated.
	It becomes problematic when handling $ep$ collisions.
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_scaled_sf_chains => &
	term_instance_evaluate_scaled_sf_chains
	<<Instances: main procedures>>=
	subroutine term_instance_evaluate_scaled_sf_chains (term, kin)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(inout) :: kin
	class(sf_rescale_t), allocatable :: sf_rescale
	if (.not. term%pcm%has_pdfs) return
	if (term%nlo_type == NLO_REAL) then
	if (term%is_subtraction ()) then
	allocate (sf_rescale_collinear_t :: sf_rescale)
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	select type (sf_rescale)
	type is (sf_rescale_collinear_t)
	call sf_rescale%set (pcm_work%real_kinematics%xi_tilde)
	end select
	end select
	call kin%sf_chain%evaluate (term%get_fac_scale (), &
	term%negative_sf, sf_rescale)
	deallocate (sf_rescale)
	else if (kin%emitter >= 0 .and. kin%emitter <= kin%n_in) then
	allocate (sf_rescale_real_t :: sf_rescale)
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	select type (sf_rescale)
	type is (sf_rescale_real_t)
	call sf_rescale%set (pcm_work%real_kinematics%xi_tilde * &
	pcm_work%real_kinematics%xi_max (kin%i_phs), &
	pcm_work%real_kinematics%y (kin%i_phs))
	end select
	end select
	call kin%sf_chain%evaluate (term%get_fac_scale (), &
	term%negative_sf, sf_rescale)
	deallocate (sf_rescale)
	else
	call kin%sf_chain%evaluate (term%get_fac_scale (), term%negative_sf)
	end if
	else if (term%nlo_type == NLO_DGLAP) then
	allocate (sf_rescale_dglap_t :: sf_rescale)
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	select type (sf_rescale)
	type is (sf_rescale_dglap_t)
	call sf_rescale%set (pcm_work%isr_kinematics%z)
	end select
	end select
	call kin%sf_chain%evaluate (term%get_fac_scale (), &
	term%negative_sf, sf_rescale)
	deallocate (sf_rescale)
	end if
	end subroutine term_instance_evaluate_scaled_sf_chains

	@ %def term_instance_evaluate_scaled_sf_chains
	@ Evaluate the extra data that we need for processing the object as a
	physical event.
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_event_data => term_instance_evaluate_event_data
	<<Instances: sub interfaces>>=
	module subroutine term_instance_evaluate_event_data (term)
	class(term_instance_t), intent(inout) :: term
	end subroutine term_instance_evaluate_event_data
	<<Instances: procedures>>=
	module subroutine term_instance_evaluate_event_data (term)
	class(term_instance_t), intent(inout) :: term
	logical :: only_momenta
	only_momenta = term%nlo_type > BORN
	call term%isolated%evaluate_event_data (only_momenta)
	call term%connected%evaluate_event_data (only_momenta)
	end subroutine term_instance_evaluate_event_data

	@ %def term_instance_evaluate_event_data
	@
	<<Instances: term instance: TBP>>=
	procedure :: set_fac_scale => term_instance_set_fac_scale
	<<Instances: sub interfaces>>=
	module subroutine term_instance_set_fac_scale (term, fac_scale)
	class(term_instance_t), intent(inout) :: term
	real(default), intent(in) :: fac_scale
	end subroutine term_instance_set_fac_scale
	<<Instances: procedures>>=
	module subroutine term_instance_set_fac_scale (term, fac_scale)
	class(term_instance_t), intent(inout) :: term
	real(default), intent(in) :: fac_scale
	term%fac_scale = fac_scale
	end subroutine term_instance_set_fac_scale

	@ %def term_instance_set_fac_scale
	@ Return data that might be useful for external processing. The
	factorization scale and renormalization scale are identical to the
	general scale if not explicitly set:
	<<Instances: term instance: TBP>>=
	procedure :: get_fac_scale => term_instance_get_fac_scale
	procedure :: get_ren_scale => term_instance_get_ren_scale
	<<Instances: sub interfaces>>=
	module function term_instance_get_fac_scale (term) result (fac_scale)
	class(term_instance_t), intent(in) :: term
	real(default) :: fac_scale
	end function term_instance_get_fac_scale
	module function term_instance_get_ren_scale (term) result (ren_scale)
	class(term_instance_t), intent(in) :: term
	real(default) :: ren_scale
	end function term_instance_get_ren_scale
	<<Instances: procedures>>=
	module function term_instance_get_fac_scale (term) result (fac_scale)
	class(term_instance_t), intent(in) :: term
	real(default) :: fac_scale
	if (allocated (term%fac_scale)) then
	fac_scale = term%fac_scale
	else
	fac_scale = term%scale
	end if
	end function term_instance_get_fac_scale

	module function term_instance_get_ren_scale (term) result (ren_scale)
	class(term_instance_t), intent(in) :: term
	real(default) :: ren_scale
	if (allocated (term%ren_scale)) then
	ren_scale = term%ren_scale
	else
	ren_scale = term%scale
	end if
	end function term_instance_get_ren_scale

	@ %def term_instance_get_fac_scale term_instance_get_ren_scale
	@ We take the strong coupling from the process core. The value is calculated
	when a new event is requested, so we should call it only after the event has
	been evaluated. If it is not available there (a negative number is returned),
	we take the value stored in the term configuration, which should be determined
	by the model. If the model does not provide a value, the result is zero.
	<<Instances: term instance: TBP>>=
	procedure :: get_alpha_s => term_instance_get_alpha_s
	<<Instances: sub interfaces>>=
	module function term_instance_get_alpha_s (term, core) result (alpha_s)
	class(term_instance_t), intent(in) :: term
	class(prc_core_t), intent(in) :: core
	real(default) :: alpha_s
	end function term_instance_get_alpha_s
	<<Instances: procedures>>=
	module function term_instance_get_alpha_s (term, core) result (alpha_s)
	class(term_instance_t), intent(in) :: term
	class(prc_core_t), intent(in) :: core
	real(default) :: alpha_s
	alpha_s = core%get_alpha_s (term%core_state)
	if (alpha_s < zero) alpha_s = term%config%alpha_s
	end function term_instance_get_alpha_s

	@ %def term_instance_get_alpha_s
	@ The second helicity for [[helicities]] comes with a minus sign
	because OpenLoops inverts the helicity index of antiparticles.
	<<Instances: term instance: TBP>>=
	procedure :: get_helicities_for_openloops => &
	term_instance_get_helicities_for_openloops
	<<Instances: sub interfaces>>=
	module subroutine term_instance_get_helicities_for_openloops &
	(term, helicities)
	class(term_instance_t), intent(in) :: term
	integer, dimension(:,:), allocatable, intent(out) :: helicities
	end subroutine term_instance_get_helicities_for_openloops
	<<Instances: procedures>>=
	module subroutine term_instance_get_helicities_for_openloops &
	(term, helicities)
	class(term_instance_t), intent(in) :: term
	integer, dimension(:,:), allocatable, intent(out) :: helicities
	type(helicity_t), dimension(:), allocatable :: hel
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	type(quantum_numbers_mask_t) :: qn_mask
	integer :: h, i, j, n_in
	call qn_mask%set_sub (1)
	call term%isolated%trace%get_quantum_numbers_mask (qn_mask, qn)
	n_in = term%int_hard%get_n_in ()
	allocate (helicities (size (qn, dim=1), n_in))
	allocate (hel (n_in))
	do i = 1, size (qn, dim=1)
	do j = 1, n_in
	hel(j) = qn(i, j)%get_helicity ()
	call hel(j)%diagonalize ()
	call hel(j)%get_indices (h, h)
	helicities (i, j) = h
	end do
	end do
	end subroutine term_instance_get_helicities_for_openloops

	@ %def term_instance_get_helicities_for_openloops
	@
	<<Instances: term instance: TBP>>=
	procedure :: get_i_term_global => term_instance_get_i_term_global
	<<Instances: sub interfaces>>=
	elemental module function term_instance_get_i_term_global &
	(term) result (i_term)
	integer :: i_term
	class(term_instance_t), intent(in) :: term
	end function term_instance_get_i_term_global
	<<Instances: procedures>>=
	elemental module function term_instance_get_i_term_global &
	(term) result (i_term)
	integer :: i_term
	class(term_instance_t), intent(in) :: term
	i_term = term%config%i_term_global
	end function term_instance_get_i_term_global

	@ %def term_instance_get_i_term_global
	@
	<<Instances: term instance: TBP>>=
	procedure :: is_subtraction => term_instance_is_subtraction
	<<Instances: sub interfaces>>=
	elemental module function term_instance_is_subtraction (term) result (sub)
	logical :: sub
	class(term_instance_t), intent(in) :: term
	end function term_instance_is_subtraction
	<<Instances: procedures>>=
	elemental module function term_instance_is_subtraction (term) result (sub)
	logical :: sub
	class(term_instance_t), intent(in) :: term
	sub = term%config%i_term_global == term%config%i_sub
	end function term_instance_is_subtraction

	@ %def term_instance_is_subtraction
	@ Retrieve [[n_sub]] which was calculated in [[process_term_setup_interaction]].
	<<Instances: term instance: TBP>>=
	procedure :: get_n_sub => term_instance_get_n_sub
	procedure :: get_n_sub_color => term_instance_get_n_sub_color
	procedure :: get_n_sub_spin => term_instance_get_n_sub_spin
	<<Instances: sub interfaces>>=
	module function term_instance_get_n_sub (term) result (n_sub)
	integer :: n_sub
	class(term_instance_t), intent(in) :: term
	end function term_instance_get_n_sub
	module function term_instance_get_n_sub_color (term) result (n_sub_color)
	integer :: n_sub_color
	class(term_instance_t), intent(in) :: term
	end function term_instance_get_n_sub_color
	module function term_instance_get_n_sub_spin (term) result (n_sub_spin)
	integer :: n_sub_spin
	class(term_instance_t), intent(in) :: term
	end function term_instance_get_n_sub_spin
	<<Instances: procedures>>=
	module function term_instance_get_n_sub (term) result (n_sub)
	integer :: n_sub
	class(term_instance_t), intent(in) :: term
	n_sub = term%config%n_sub
	end function term_instance_get_n_sub

	module function term_instance_get_n_sub_color (term) result (n_sub_color)
	integer :: n_sub_color
	class(term_instance_t), intent(in) :: term
	n_sub_color = term%config%n_sub_color
	end function term_instance_get_n_sub_color

	module function term_instance_get_n_sub_spin (term) result (n_sub_spin)
	integer :: n_sub_spin
	class(term_instance_t), intent(in) :: term
	n_sub_spin = term%config%n_sub_spin
	end function term_instance_get_n_sub_spin

	@ %def term_instance_get_n_sub
	@ %def term_instance_get_n_sub_color
	@ %def term_instance_get_n_sub_spin
	@
	\subsection{The process instance}
	NOTE: The description below represents the intended structure after
	refactoring and disentangling the FKS-NLO vs. LO algorithm dependencies.

	A process instance contains all process data that depend on the
	sampling point and thus change often. In essence, it is an event
	record at the elementary (parton) level. We do not call it such, to
	avoid confusion with the actual event records. If decays are
	involved, the latter are compositions of several elementary processes
	(i.e., their instances).

	We implement the process instance as an extension of the
	[[mci_sampler_t]] that we need for computing integrals and generate
	events.

	The base type contains: the [[integrand]], the [[selected_channel]],
	the two-dimensional array [[x]] of parameters, and the one-dimensional
	array [[f]] of Jacobians. These subobjects are public and used for
	communicating with the multi-channel integrator.

	The [[process]] pointer accesses the process of which this record is
	an instance. It is required whenever the calculation needs invariant
	configuration data, therefore the process should stay in memory for
	the whole lifetime of its instances.

	The [[pcm]] pointer is a shortcut to the [[pcm]] (process-component
	manager) component of the associated process, which we need wherever
	the calculation depends on the overall algorithm.

	The [[pcm_work]] component is the workspace for the [[pcm]] object
	referenced above.

	The [[evaluation_status]] code is used to check the current status.
	In particular, failure at various stages is recorded there.

	The [[count]] object records process evaluations, broken down
	according to status.

	The [[sqme]] value is the single real number that results from
	evaluating and tracing the kinematics and matrix elements. This
	is the number that is handed over to an integration routine.

	The [[weight]] value is the event weight. It is defined when an event
	has been generated from the process instance, either weighted or
	unweighted. The value is the [[sqme]] value times Jacobian weights
	from the integration, or unity, respectively.

	The [[i_mci]] index chooses a subset of components that are associated with
	a common parameter set and integrator, i.e., that are added coherently.

	The [[sf_chain]] subobject is a realization of the beam and
	structure-function configuration in the [[process]] object. It is not
	used for calculation directly but serves as the template for the
	sf-chain instances that are contained in the [[component]] objects.

	The [[kinematics]] array contains the set of phase-space points that
	are associated with the current calculation. The entries may correspond
	to different process components and terms. (TODO wk 19-02-22: Not implemented yet.)

	TODO wk 19-02-22: May include extra arrays for storing (squared) amplitude
	data. The [[term]] data set may be reduced to just results, or
	be removed altogether.

	The [[term]] subobjects are workspace for evaluating kinematics,
	matrix elements, cuts etc. The array entries correspond to the [[term]]
	configuration entries in the associated process object.

	The [[mci_work]] subobject contains the array of real input parameters (random
	numbers) that generates the kinematical point. It also contains the workspace
	for the MC integrators. The active entry of the [[mci_work]] array is
	selected by the [[i_mci]] index above.

	The [[hook]] pointer accesses a list of after evaluate objects which are
	evalutated after the matrix element.
	<<Instances: public>>=
	public :: process_instance_t
	<<Instances: types>>=
	type, extends (mci_sampler_t) :: process_instance_t
	type(process_t), pointer :: process => null ()
	class(pcm_t), pointer :: pcm => null ()
	class(pcm_workspace_t), allocatable :: pcm_work
	integer :: evaluation_status = STAT_UNDEFINED
	real(default) :: sqme = 0
	real(default) :: weight = 0
	real(default) :: excess = 0
	integer :: n_dropped = 0
	integer :: i_mci = 0
	integer :: selected_channel = 0
	type(sf_chain_t) :: sf_chain
	type(kinematics_t), dimension(:), allocatable :: kin
	type(term_instance_t), dimension(:), allocatable :: term
	type(mci_work_t), dimension(:), allocatable :: mci_work
	class(process_instance_hook_t), pointer :: hook => null ()
	contains
	<<Instances: process instance: TBP>>
	end type process_instance_t

	@ %def process_instance
	@
	Wrapper type for storing pointers to process instance objects in arrays.
	<<Instances: public>>=
	public :: process_instance_ptr_t
	<<Instances: types>>=
	type :: process_instance_ptr_t
	type(process_instance_t), pointer :: p => null ()
	end type process_instance_ptr_t

	@ %def process_instance_ptr_t
	@ The process hooks are first-in-last-out list of objects which are evaluated
	after the phase space and matrixelement are evaluated. It is possible to
	retrieve the sampler object and read the sampler information.

	The hook object are part of the [[process_instance]] and therefore, share a
	common lifetime. A data transfer, after the usual lifetime of the
	[[process_instance]], is not provided, as such the finalisation procedure has to take care
	of this! E.g. write the object to file from which later the collected
	information can then be retrieved.
	<<Instances: public>>=
	public :: process_instance_hook_t
	<<Instances: types>>=
	type, abstract :: process_instance_hook_t
	class(process_instance_hook_t), pointer :: next => null ()
	contains
	procedure(process_instance_hook_init), deferred :: init
	procedure(process_instance_hook_final), deferred :: final
	procedure(process_instance_hook_evaluate), deferred :: evaluate
	end type process_instance_hook_t

	@ %def process_instance_hook_t
	@ We have to provide an [[init]], a [[final]] procedure and, for after evaluation, the
	[[evaluate]] procedure.

	The [[init]] procedures accesses [[var_list]] and current [[instance]] object.
	<<Instances: public>>=
	public :: process_instance_hook_final, process_instance_hook_evaluate
	<<Instances: interfaces>>=
	abstract interface
	subroutine process_instance_hook_init (hook, var_list, instance, pdf_data)
	import :: process_instance_hook_t, var_list_t, process_instance_t, pdf_data_t
	class(process_instance_hook_t), intent(inout), target :: hook
	type(var_list_t), intent(in) :: var_list
	class(process_instance_t), intent(in), target :: instance
	type(pdf_data_t), intent(in), optional :: pdf_data
	end subroutine process_instance_hook_init

	subroutine process_instance_hook_final (hook)
	import :: process_instance_hook_t
	class(process_instance_hook_t), intent(inout) :: hook
	end subroutine process_instance_hook_final

	subroutine process_instance_hook_evaluate (hook, instance)
	import :: process_instance_hook_t, process_instance_t
	class(process_instance_hook_t), intent(inout) :: hook
	class(process_instance_t), intent(in), target :: instance
	end subroutine process_instance_hook_evaluate
	end interface

	@ %def process_instance_hook_final, process_instance_hook_evaluate
	@ The output routine contains a header with the most relevant
	information about the process, copied from
	[[process_metadata_write]]. We mark the active components by an asterisk.

	The next section is the MC parameter input. The following sections
	are written only if the evaluation status is beyond setting the
	parameters, or if the [[verbose]] option is set.
	<<Instances: process instance: TBP>>=
	procedure :: write_header => process_instance_write_header
	procedure :: write => process_instance_write
	<<Instances: sub interfaces>>=
	module subroutine process_instance_write_header (object, unit, testflag)
	class(process_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine process_instance_write_header
	module subroutine process_instance_write (object, unit, testflag)
	class(process_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine process_instance_write
	<<Instances: procedures>>=
	module subroutine process_instance_write_header (object, unit, testflag)
	class(process_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	if (associated (object%process)) then
	call object%process%write_meta (u, testflag)
	else
	write (u, "(1x,A)") "Process instance [undefined process]"
	return
	end if
	write (u, "(3x,A)", advance = "no") "status = "
	select case (object%evaluation_status)
	case (STAT_INITIAL); write (u, "(A)") "initialized"
	case (STAT_ACTIVATED); write (u, "(A)") "activated"
	case (STAT_BEAM_MOMENTA); write (u, "(A)") "beam momenta set"
	case (STAT_FAILED_KINEMATICS); write (u, "(A)") "failed kinematics"
	case (STAT_SEED_KINEMATICS); write (u, "(A)") "seed kinematics"
	case (STAT_HARD_KINEMATICS); write (u, "(A)") "hard kinematics"
	case (STAT_EFF_KINEMATICS); write (u, "(A)") "effective kinematics"
	case (STAT_FAILED_CUTS); write (u, "(A)") "failed cuts"
	case (STAT_PASSED_CUTS); write (u, "(A)") "passed cuts"
	case (STAT_EVALUATED_TRACE); write (u, "(A)") "evaluated trace"
	call write_separator (u)
	write (u, "(3x,A,ES19.12)") "sqme = ", object%sqme
	case (STAT_EVENT_COMPLETE); write (u, "(A)") "event complete"
	call write_separator (u)
	write (u, "(3x,A,ES19.12)") "sqme = ", object%sqme
	write (u, "(3x,A,ES19.12)") "weight = ", object%weight
	if (.not. vanishes (object%excess)) &
	write (u, "(3x,A,ES19.12)") "excess = ", object%excess
	case default; write (u, "(A)") "undefined"
	end select
	if (object%i_mci /= 0) then
	call write_separator (u)
	call object%mci_work(object%i_mci)%write (u, testflag)
	end if
	call write_separator (u, 2)
	end subroutine process_instance_write_header

	module subroutine process_instance_write (object, unit, testflag)
	class(process_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u, i
	u = given_output_unit (unit)
	call object%write_header (u)
	if (object%evaluation_status >= STAT_BEAM_MOMENTA) then
	call object%sf_chain%write (u)
	call write_separator (u, 2)
	if (object%evaluation_status >= STAT_SEED_KINEMATICS) then
	if (object%evaluation_status >= STAT_HARD_KINEMATICS) then
	call write_separator (u, 2)
	write (u, "(1x,A)") "Active terms:"
	if (any (object%term%active)) then
	do i = 1, size (object%term)
	if (object%term(i)%active) then
	call write_separator (u)
	call object%term(i)%write (u, &
	kin = object%kin(i), &
	show_eff_state = &
	object%evaluation_status >= STAT_EFF_KINEMATICS, &
	testflag = testflag)
	end if
	end do
	end if
	end if
	call write_separator (u, 2)
	end if
	end if
	end subroutine process_instance_write

	@ %def process_instance_write_header
	@ %def process_instance_write
	@ Initialization connects the instance with a process. All initial
	information is transferred from the process object. The process
	object contains templates for the interaction subobjects (beam and
	term), but no evaluators. The initialization routine
	creates evaluators for the matrix element trace, other evaluators
	are left untouched.

	Before we start generating, we double-check if the process library
	has been updated after the process was initializated
	([[check_library_sanity]]). This may happen if between integration
	and event generation the library has been recompiled, so all links
	become broken.

	The [[instance]] object must have the [[target]] attribute (also in
	any caller) since the initialization routine assigns various pointers
	to subobject of [[instance]].
	<<Instances: process instance: TBP>>=
	procedure :: init => process_instance_init
	<<Instances: sub interfaces>>=
	module subroutine process_instance_init (instance, process)
	class(process_instance_t), intent(out), target :: instance
	type(process_t), intent(inout), target :: process
	end subroutine process_instance_init
	<<Instances: procedures>>=
	module subroutine process_instance_init (instance, process)
	class(process_instance_t), intent(out), target :: instance
	type(process_t), intent(inout), target :: process
	integer :: i
	class(pcm_t), pointer :: pcm
	type(process_term_t), pointer :: term
	type(var_list_t), pointer :: var_list
	integer :: i_born, i_real, i_real_fin, i_component
	if (debug_on) call msg_debug &
	(D_PROCESS_INTEGRATION, "process_instance_init")
	instance%process => process
	instance%pcm => process%get_pcm_ptr ()
	call instance%process%check_library_sanity ()
	call instance%setup_sf_chain (process%get_beam_config_ptr ())
	allocate (instance%mci_work (process%get_n_mci ()))
	do i = 1, size (instance%mci_work)
	call instance%process%init_mci_work (instance%mci_work(i), i)
	end do
	call instance%process%reset_selected_cores ()
	pcm => instance%process%get_pcm_ptr ()
	call pcm%allocate_workspace (instance%pcm_work)
	select type (pcm)
	type is (pcm_nlo_t)
	!!! The process is kept when the integration is finalized, but not the
	!!! process_instance. Thus, we check whether pcm has been initialized
	!!! but set up the pcm_work each time.
	i_real_fin = process%get_associated_real_fin (1)
	if (.not. pcm%initialized) then
	i_born = pcm%get_i_core (pcm%i_born)
	i_real = pcm%get_i_core (pcm%i_real)
	call pcm%init_qn (process%get_model_ptr ())
	if (i_real_fin > 0) call pcm%allocate_ps_matching ()
	var_list => process%get_var_list_ptr ()
	if (var_list%get_sval (var_str ("$dalitz_plot")) /= var_str ('')) &
	call pcm%activate_dalitz_plot (var_list%get_sval (var_str ("$dalitz_plot")))
	end if
	pcm%initialized = .true.
	select type (pcm_work => instance%pcm_work)
	type is (pcm_nlo_workspace_t)
	call pcm_work%init_config (pcm, &
	process%component_can_be_integrated (), &
	process%get_nlo_type_component (), process%get_energy (), &
	i_real_fin, process%get_model_ptr ())
	end select
	end select
	! TODO wk-03-01 n_terms will eventually acquire a different meaning
	allocate (instance%kin (process%get_n_terms ()))
	do i = 1, process%get_n_terms ()
	term => process%get_term_ptr (i)
	i_component = term%i_component
	call instance%kin(i)%configure (pcm, instance%pcm_work, &
	instance%sf_chain, &
	process%get_beam_config_ptr (), &
	process%get_phs_config (i_component), &
	process%get_nlo_type_component (i_component), &
	term%i_sub == i)
	end do
	! TODO wk-03-01 n_terms will eventually acquire a different meaning
	allocate (instance%term (process%get_n_terms ()))
	do i = 1, process%get_n_terms ()
	call instance%term(i)%configure (process, i, instance%pcm_work, &
	instance%sf_chain, instance%kin(i))
	end do
	call instance%set_i_mci_to_real_component ()
	call instance%find_same_kinematics ()
	instance%evaluation_status = STAT_INITIAL
	end subroutine process_instance_init

	@ %def process_instance_init
	@
	@ Finalize all subobjects that may contain allocated pointers.
	<<Instances: process instance: TBP>>=
	procedure :: final => process_instance_final
	<<Instances: sub interfaces>>=
	module subroutine process_instance_final (instance)
	class(process_instance_t), intent(inout) :: instance
	end subroutine process_instance_final
	<<Instances: procedures>>=
	module subroutine process_instance_final (instance)
	class(process_instance_t), intent(inout) :: instance
	class(process_instance_hook_t), pointer :: current
	integer :: i
	instance%process => null ()
	if (allocated (instance%mci_work)) then
	do i = 1, size (instance%mci_work)
	call instance%mci_work(i)%final ()
	end do
	deallocate (instance%mci_work)
	end if
	call instance%sf_chain%final ()
	if (allocated (instance%kin)) then
	do i = 1, size (instance%kin)
	call instance%kin(i)%final ()
	end do
	deallocate (instance%kin)
	end if
	if (allocated (instance%term)) then
	do i = 1, size (instance%term)
	call instance%term(i)%final ()
	end do
	deallocate (instance%term)
	end if
	call instance%pcm_work%final ()
	instance%evaluation_status = STAT_UNDEFINED
	do while (associated (instance%hook))
	current => instance%hook
	call current%final ()
	instance%hook => current%next
	deallocate (current)
	end do
	instance%hook => null ()
	end subroutine process_instance_final

	@ %def process_instance_final
	@ Revert the process instance to initial state. We do not deallocate
	anything, just reset the state index and deactivate all components and
	terms.

	We do not reset the choice of the MCI set [[i_mci]] unless this is
	required explicitly.
	<<Instances: process instance: TBP>>=
	procedure :: reset => process_instance_reset
	<<Instances: sub interfaces>>=
	module subroutine process_instance_reset (instance, reset_mci)
	class(process_instance_t), intent(inout), target :: instance
	logical, intent(in), optional :: reset_mci
	end subroutine process_instance_reset
	<<Instances: procedures>>=
	module subroutine process_instance_reset (instance, reset_mci)
	class(process_instance_t), intent(inout), target :: instance
	logical, intent(in), optional :: reset_mci
	integer :: i
	call instance%process%reset_selected_cores ()
	do i = 1, size (instance%term)
	call instance%term(i)%reset ()
	end do
	instance%term%checked = .false.
	instance%term%passed = .false.
	instance%kin%new_seed = .true.
	if (present (reset_mci)) then
	if (reset_mci) instance%i_mci = 0
	end if
	instance%selected_channel = 0
	instance%evaluation_status = STAT_INITIAL
	end subroutine process_instance_reset

	@ %def process_instance_reset
	@
	\subsubsection{Integration and event generation}
	The sampler test should just evaluate the squared matrix element [[n_calls]]
	times, discarding the results, and return. This can be done before
	integration, e.g., for timing estimates.
	<<Instances: process instance: TBP>>=
	procedure :: sampler_test => process_instance_sampler_test
	<<Instances: sub interfaces>>=
	module subroutine process_instance_sampler_test (instance, i_mci, n_calls)
	class(process_instance_t), intent(inout), target :: instance
	integer, intent(in) :: i_mci
	integer, intent(in) :: n_calls
	end subroutine process_instance_sampler_test
	<<Instances: procedures>>=
	module subroutine process_instance_sampler_test (instance, i_mci, n_calls)
	class(process_instance_t), intent(inout), target :: instance
	integer, intent(in) :: i_mci
	integer, intent(in) :: n_calls
	integer :: i_mci_work
	i_mci_work = instance%process%get_i_mci_work (i_mci)
	call instance%choose_mci (i_mci_work)
	call instance%reset_counter ()
	call instance%process%sampler_test (instance, n_calls, i_mci_work)
	call instance%process%set_counter_mci_entry (i_mci_work, instance%get_counter ())
	end subroutine process_instance_sampler_test

	@ %def process_instance_sampler_test
	@ Generate a weighted event. We select one of the available MCI
	integrators by its index [[i_mci]] and thus generate an event for the
	associated (group of) process component(s). The arguments exactly
	correspond to the initializer and finalizer above.

	The resulting event is stored in the [[process_instance]] object,
	which also holds the workspace of the integrator.

	Note: The [[process]] object contains the random-number state, which
	changes for each event.
	Otherwise, all volatile data are inside the [[instance]] object.
	<<Instances: process instance: TBP>>=
	procedure :: generate_weighted_event => &
	process_instance_generate_weighted_event
	<<Instances: sub interfaces>>=
	module subroutine process_instance_generate_weighted_event (instance, i_mci)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	end subroutine process_instance_generate_weighted_event
	<<Instances: procedures>>=
	module subroutine process_instance_generate_weighted_event (instance, i_mci)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	integer :: i_mci_work
	i_mci_work = instance%process%get_i_mci_work (i_mci)
	call instance%choose_mci (i_mci_work)
	associate (mci_work => instance%mci_work(i_mci_work))
	call instance%process%generate_weighted_event &
	(i_mci_work, mci_work, instance, &
	instance%keep_failed_events ())
	end associate
	end subroutine process_instance_generate_weighted_event

	@ %def process_instance_generate_weighted_event
	@
	<<Instances: process instance: TBP>>=
	procedure :: generate_unweighted_event => &
	process_instance_generate_unweighted_event
	<<Instances: sub interfaces>>=
	module subroutine process_instance_generate_unweighted_event &
	(instance, i_mci)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	end subroutine process_instance_generate_unweighted_event
	<<Instances: procedures>>=
	module subroutine process_instance_generate_unweighted_event (instance, i_mci)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	integer :: i_mci_work
	i_mci_work = instance%process%get_i_mci_work (i_mci)
	call instance%choose_mci (i_mci_work)
	associate (mci_work => instance%mci_work(i_mci_work))
	call instance%process%generate_unweighted_event &
	(i_mci_work, mci_work, instance)
	end associate
	end subroutine process_instance_generate_unweighted_event

	@ %def process_instance_generate_unweighted_event
	@ This replaces the event generation methods for the situation that the
	process instance object has been filled by other means (i.e., reading
	and/or recalculating its contents). We just have to fill in missing
	MCI data, especially the event weight.
	<<Instances: process instance: TBP>>=
	procedure :: recover_event => process_instance_recover_event
	<<Instances: sub interfaces>>=
	module subroutine process_instance_recover_event (instance)
	class(process_instance_t), intent(inout) :: instance
	end subroutine process_instance_recover_event
	<<Instances: procedures>>=
	module subroutine process_instance_recover_event (instance)
	class(process_instance_t), intent(inout) :: instance
	integer :: i_mci
	i_mci = instance%i_mci
	call instance%process%set_i_mci_work (i_mci)
	associate (mci_instance => instance%mci_work(i_mci)%mci)
	call mci_instance%fetch (instance, instance%selected_channel)
	end associate
	end subroutine process_instance_recover_event

	@ %def process_instance_recover_event
	@ Activate the components and terms that correspond to a currently
	selected MCI parameter set.
	<<Instances: process instance: TBP>>=
	procedure :: activate => process_instance_activate
	<<Instances: sub interfaces>>=
	module subroutine process_instance_activate (instance)
	class(process_instance_t), intent(inout) :: instance
	end subroutine process_instance_activate
	<<Instances: procedures>>=
	module subroutine process_instance_activate (instance)
	class(process_instance_t), intent(inout) :: instance
	integer :: i, j
	integer, dimension(:), allocatable :: i_term
	associate (mci_work => instance%mci_work(instance%i_mci))
	call instance%process%select_components &
	(mci_work%get_active_components ())
	end associate
	associate (process => instance%process)
	do i = 1, instance%process%get_n_components ()
	if (instance%process%component_is_selected (i)) then
	allocate (i_term (size (process%get_component_i_terms (i))))
	i_term = process%get_component_i_terms (i)
	do j = 1, size (i_term)
	instance%term(i_term(j))%active = .true.
	end do
	end if
	if (allocated (i_term)) deallocate (i_term)
	end do
	end associate
	instance%evaluation_status = STAT_ACTIVATED
	end subroutine process_instance_activate

	@ %def process_instance_activate
	@
	<<Instances: process instance: TBP>>=
	procedure :: find_same_kinematics => process_instance_find_same_kinematics
	<<Instances: sub interfaces>>=
	module subroutine process_instance_find_same_kinematics (instance)
	class(process_instance_t), intent(inout) :: instance
	end subroutine process_instance_find_same_kinematics
	<<Instances: procedures>>=
	module subroutine process_instance_find_same_kinematics (instance)
	class(process_instance_t), intent(inout) :: instance
	integer :: i_term1, i_term2, k, n_same
	do i_term1 = 1, size (instance%term)
	if (.not. allocated (instance%term(i_term1)%same_kinematics)) then
	n_same = 1 !!! Index group includes the index of its term_instance
	do i_term2 = 1, size (instance%term)
	if (i_term1 == i_term2) cycle
	if (compare_md5s (i_term1, i_term2)) n_same = n_same + 1
	end do
	allocate (instance%term(i_term1)%same_kinematics (n_same))
	associate (same_kinematics1 => instance%term(i_term1)%same_kinematics)
	same_kinematics1 = 0
	k = 1
	do i_term2 = 1, size (instance%term)
	if (compare_md5s (i_term1, i_term2)) then
	same_kinematics1(k) = i_term2
	k = k + 1
	end if
	end do
	do k = 1, size (same_kinematics1)
	if (same_kinematics1(k) == i_term1) cycle
	i_term2 = same_kinematics1(k)
	allocate (instance%term(i_term2)%same_kinematics (n_same))
	instance%term(i_term2)%same_kinematics = same_kinematics1
	end do
	end associate
	end if
	end do
	contains
	function compare_md5s (i, j) result (same)
	logical :: same
	integer, intent(in) :: i, j
	character(32) :: md5sum_1, md5sum_2
	integer :: mode_1, mode_2
	mode_1 = 0; mode_2 = 0
	select type (phs => instance%kin(i)%phs%config)
	type is (phs_fks_config_t)
	md5sum_1 = phs%md5sum_born_config
	mode_1 = phs%mode
	class default
	md5sum_1 = phs%md5sum_phs_config
	end select
	select type (phs => instance%kin(j)%phs%config)
	type is (phs_fks_config_t)
	md5sum_2 = phs%md5sum_born_config
	mode_2 = phs%mode
	class default
	md5sum_2 = phs%md5sum_phs_config
	end select
	same = (md5sum_1 == md5sum_2) .and. (mode_1 == mode_2)
	end function compare_md5s
	end subroutine process_instance_find_same_kinematics

	@ %def process_instance_find_same_kinematics
	@
	<<Instances: process instance: TBP>>=
	procedure :: transfer_same_kinematics => &
	process_instance_transfer_same_kinematics
	<<Instances: sub interfaces>>=
	module subroutine process_instance_transfer_same_kinematics &
	(instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	end subroutine process_instance_transfer_same_kinematics
	<<Instances: procedures>>=
	module subroutine process_instance_transfer_same_kinematics (instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	integer :: i, i_term_same
	associate (same_kinematics => instance%term(i_term)%same_kinematics)
	do i = 1, size (same_kinematics)
	i_term_same = same_kinematics(i)
	instance%term(i_term_same)%p_seed = instance%term(i_term)%p_seed
	associate (phs => instance%kin(i_term_same)%phs)
	call phs%set_lorentz_transformation &
	(instance%kin(i_term)%phs%get_lorentz_transformation ())
	select type (phs)
	type is (phs_fks_t)
	call phs%set_momenta (instance%term(i_term_same)%p_seed)
	if (i_term_same /= i_term) then
	call phs%set_reference_frames (.false.)
	end if
	end select
	end associate
	instance%kin(i_term_same)%new_seed = .false.
	end do
	end associate
	end subroutine process_instance_transfer_same_kinematics

	@ %def process_instance_transfer_same_kinematics
	@
	<<Instances: process instance: TBP>>=
	procedure :: redo_sf_chains => process_instance_redo_sf_chains
	<<Instances: sub interfaces>>=
	module subroutine process_instance_redo_sf_chains &
	(instance, i_term, phs_channel)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in), dimension(:) :: i_term
	integer, intent(in) :: phs_channel
	end subroutine process_instance_redo_sf_chains
	<<Instances: procedures>>=
	module subroutine process_instance_redo_sf_chains &
	(instance, i_term, phs_channel)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in), dimension(:) :: i_term
	integer, intent(in) :: phs_channel
	integer :: i
	do i = 1, size (i_term)
	call instance%kin(i_term(i))%redo_sf_chain &
	(instance%mci_work(instance%i_mci), phs_channel)
	end do
	end subroutine process_instance_redo_sf_chains

	@ %def process_instance_redo_sf_chains
	@ Integrate the process, using a previously initialized process
	instance. We select one of the available MCI integrators by its index
	[[i_mci]] and thus integrate over (structure functions and) phase
	space for the associated (group of) process component(s).
	<<Instances: process instance: TBP>>=
	procedure :: integrate => process_instance_integrate
	<<Instances: sub interfaces>>=
	module subroutine process_instance_integrate (instance, i_mci, &
	n_it, n_calls, adapt_grids, adapt_weights, final, pacify)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	integer, intent(in) :: n_it
	integer, intent(in) :: n_calls
	logical, intent(in), optional :: adapt_grids
	logical, intent(in), optional :: adapt_weights
	logical, intent(in), optional :: final, pacify
	end subroutine process_instance_integrate
	<<Instances: procedures>>=
	module subroutine process_instance_integrate (instance, i_mci, &
	n_it, n_calls, adapt_grids, adapt_weights, final, pacify)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	integer, intent(in) :: n_it
	integer, intent(in) :: n_calls
	logical, intent(in), optional :: adapt_grids
	logical, intent(in), optional :: adapt_weights
	logical, intent(in), optional :: final, pacify
	integer :: nlo_type, i_mci_work
	nlo_type = instance%process%get_component_nlo_type (i_mci)
	i_mci_work = instance%process%get_i_mci_work (i_mci)
	call instance%choose_mci (i_mci_work)
	call instance%reset_counter ()
	associate (mci_work => instance%mci_work(i_mci_work), &
	process => instance%process)
	call process%integrate (i_mci_work, mci_work, &
	instance, n_it, n_calls, adapt_grids, adapt_weights, &
	final, pacify, nlo_type = nlo_type)
	call process%set_counter_mci_entry (i_mci_work, instance%get_counter ())
	end associate
	end subroutine process_instance_integrate

	@ %def process_instance_integrate
	@ Subroutine of the initialization above: initialize the beam and
	structure-function chain template. We establish pointers to the
	configuration data, so [[beam_config]] must have a [[target]]
	attribute.

	The resulting chain is not used directly for calculation. It will
	acquire instances which are stored in the process-component instance
	objects.
	<<Instances: process instance: TBP>>=
	procedure :: setup_sf_chain => process_instance_setup_sf_chain
	<<Instances: sub interfaces>>=
	module subroutine process_instance_setup_sf_chain (instance, config)
	class(process_instance_t), intent(inout) :: instance
	type(process_beam_config_t), intent(in), target :: config
	end subroutine process_instance_setup_sf_chain
	<<Instances: procedures>>=
	module subroutine process_instance_setup_sf_chain (instance, config)
	class(process_instance_t), intent(inout) :: instance
	type(process_beam_config_t), intent(in), target :: config
	integer :: n_strfun
	n_strfun = config%n_strfun
	if (n_strfun /= 0) then
	call instance%sf_chain%init (config%data, config%sf)
	else
	call instance%sf_chain%init (config%data)
	end if
	if (config%sf_trace) then
	call instance%sf_chain%setup_tracing (config%sf_trace_file)
	end if
	end subroutine process_instance_setup_sf_chain

	@ %def process_instance_setup_sf_chain
	@ This initialization routine should be called only for process
	instances which we intend as a source for physical events. It
	initializes the evaluators in the parton states of the terms. They
	describe the (semi-)exclusive transition matrix and the distribution
	of color flow for the partonic process, convoluted with the beam and
	structure-function chain.

	If the model is not provided explicitly, we may use the model instance that
	belongs to the process. However, an explicit model allows us to override
	particle settings.
	<<Instances: process instance: TBP>>=
	procedure :: setup_event_data => process_instance_setup_event_data
	<<Instances: sub interfaces>>=
	module subroutine process_instance_setup_event_data &
	(instance, model, i_core)
	class(process_instance_t), intent(inout), target :: instance
	class(model_data_t), intent(in), optional, target :: model
	integer, intent(in), optional :: i_core
	end subroutine process_instance_setup_event_data
	<<Instances: procedures>>=
	module subroutine process_instance_setup_event_data (instance, model, i_core)
	class(process_instance_t), intent(inout), target :: instance
	class(model_data_t), intent(in), optional, target :: model
	integer, intent(in), optional :: i_core
	class(model_data_t), pointer :: current_model
	integer :: i
	class(prc_core_t), pointer :: core => null ()
	if (present (model)) then
	current_model => model
	else
	current_model => instance%process%get_model_ptr ()
	end if
	do i = 1, size (instance%term)
	associate (term => instance%term(i), kin => instance%kin(i))
	if (associated (term%config)) then
	core => instance%process%get_core_term (i)
	call term%setup_event_data (kin, core, current_model)
	end if
	end associate
	end do
	core => null ()
	end subroutine process_instance_setup_event_data

	@ %def process_instance_setup_event_data
	@ Choose a MC parameter set and the corresponding integrator.
	The choice persists beyond calls of the [[reset]] method above. This method
	is automatically called here.
	<<Instances: process instance: TBP>>=
	procedure :: choose_mci => process_instance_choose_mci
	<<Instances: sub interfaces>>=
	module subroutine process_instance_choose_mci (instance, i_mci)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	end subroutine process_instance_choose_mci
	<<Instances: procedures>>=
	module subroutine process_instance_choose_mci (instance, i_mci)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	instance%i_mci = i_mci
	call instance%reset ()
	end subroutine process_instance_choose_mci

	@ %def process_instance_choose_mci
	@ Explicitly set a MC parameter set. Works only if we are in initial
	state. We assume that the length of the parameter set is correct.

	After setting the parameters, activate the components and terms that
	correspond to the chosen MC parameter set.

	The [[warmup_flag]] is used when a dummy phase-space point is computed
	for the warmup of e.g. OpenLoops helicities. The setting of the
	the [[evaluation_status]] has to be avoided then.
	<<Instances: process instance: TBP>>=
	procedure :: set_mcpar => process_instance_set_mcpar
	<<Instances: sub interfaces>>=
	module subroutine process_instance_set_mcpar (instance, x, warmup_flag)
	class(process_instance_t), intent(inout) :: instance
	real(default), dimension(:), intent(in) :: x
	logical, intent(in), optional :: warmup_flag
	end subroutine process_instance_set_mcpar
	<<Instances: procedures>>=
	module subroutine process_instance_set_mcpar (instance, x, warmup_flag)
	class(process_instance_t), intent(inout) :: instance
	real(default), dimension(:), intent(in) :: x
	logical, intent(in), optional :: warmup_flag
	logical :: activate
	activate = .true.; if (present (warmup_flag)) activate = .not. warmup_flag
	if (instance%evaluation_status == STAT_INITIAL) then
	associate (mci_work => instance%mci_work(instance%i_mci))
	call mci_work%set (x)
	end associate
	if (activate) call instance%activate ()
	end if
	end subroutine process_instance_set_mcpar

	@ %def process_instance_set_mcpar
	@ Receive the beam momentum/momenta from a source interaction. This
	applies to a cascade decay process instance, where the `beam' momentum
	varies event by event.

	The master beam momentum array is contained in the main structure
	function chain subobject [[sf_chain]]. The sf-chain instance that
	reside in the components will take their beam momenta from there.

	The procedure transforms the instance status into
	[[STAT_BEAM_MOMENTA]]. For process instance with fixed beam, this
	intermediate status is skipped.
	<<Instances: process instance: TBP>>=
	procedure :: receive_beam_momenta => process_instance_receive_beam_momenta
	<<Instances: sub interfaces>>=
	module subroutine process_instance_receive_beam_momenta (instance)
	class(process_instance_t), intent(inout) :: instance
	end subroutine process_instance_receive_beam_momenta
	<<Instances: procedures>>=
	module subroutine process_instance_receive_beam_momenta (instance)
	class(process_instance_t), intent(inout) :: instance
	if (instance%evaluation_status >= STAT_INITIAL) then
	call instance%sf_chain%receive_beam_momenta ()
	instance%evaluation_status = STAT_BEAM_MOMENTA
	end if
	end subroutine process_instance_receive_beam_momenta

	@ %def process_instance_receive_beam_momenta
	@ Set the beam momentum/momenta explicitly. Otherwise, analogous to
	the previous procedure.
	<<Instances: process instance: TBP>>=
	procedure :: set_beam_momenta => process_instance_set_beam_momenta
	<<Instances: sub interfaces>>=
	module subroutine process_instance_set_beam_momenta (instance, p)
	class(process_instance_t), intent(inout) :: instance
	type(vector4_t), dimension(:), intent(in) :: p
	end subroutine process_instance_set_beam_momenta
	<<Instances: procedures>>=
	module subroutine process_instance_set_beam_momenta (instance, p)
	class(process_instance_t), intent(inout) :: instance
	type(vector4_t), dimension(:), intent(in) :: p
	if (instance%evaluation_status >= STAT_INITIAL) then
	call instance%sf_chain%set_beam_momenta (p)
	instance%evaluation_status = STAT_BEAM_MOMENTA
	end if
	end subroutine process_instance_set_beam_momenta

	@ %def process_instance_set_beam_momenta
	@ Recover the initial beam momenta (those in the [[sf_chain]]
	component), given a valid (recovered) [[sf_chain_instance]] in one of
	the active components. We need to do this only if the lab frame is
	not the c.m.\ frame, otherwise those beams would be fixed anyway.
	<<Instances: process instance: TBP>>=
	procedure :: recover_beam_momenta => process_instance_recover_beam_momenta
	<<Instances: sub interfaces>>=
	module subroutine process_instance_recover_beam_momenta (instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	end subroutine process_instance_recover_beam_momenta
	<<Instances: procedures>>=
	module subroutine process_instance_recover_beam_momenta (instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	if (.not. instance%process%lab_is_cm ()) then
	if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
	call instance%kin(i_term)%return_beam_momenta ()
	end if
	end if
	end subroutine process_instance_recover_beam_momenta

	@ %def process_instance_recover_beam_momenta
	@ Explicitly choose MC integration channel. We assume here that the channel
	count is identical for all active components.
	<<Instances: process instance: TBP>>=
	procedure :: select_channel => process_instance_select_channel
	<<Instances: sub interfaces>>=
	module subroutine process_instance_select_channel (instance, channel)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: channel
	end subroutine process_instance_select_channel
	<<Instances: procedures>>=
	module subroutine process_instance_select_channel (instance, channel)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: channel
	instance%selected_channel = channel
	end subroutine process_instance_select_channel

	@ %def process_instance_select_channel
	@ First step of process evaluation: set up seed kinematics. That is, for each
	active process component, compute a momentum array from the MC input
	parameters.

	If [[skip_term]] is set, we skip the component that accesses this
	term. We can assume that the associated data have already been
	recovered, and we are just computing the rest.
	<<Instances: process instance: TBP>>=
	procedure :: compute_seed_kinematics => &
	process_instance_compute_seed_kinematics
	<<Instances: sub interfaces>>=
	module subroutine process_instance_compute_seed_kinematics &
	(instance, recover, skip_term)
	class(process_instance_t), intent(inout) :: instance
	logical, intent(in), optional :: recover
	integer, intent(in), optional :: skip_term
	end subroutine process_instance_compute_seed_kinematics
	<<Instances: procedures>>=
	module subroutine process_instance_compute_seed_kinematics &
	(instance, recover, skip_term)
	class(process_instance_t), intent(inout) :: instance
	logical, intent(in), optional :: recover
	integer, intent(in), optional :: skip_term
	integer :: channel, skip_component, i, j
	logical :: success
	integer, dimension(:), allocatable :: i_term
	channel = instance%selected_channel
	if (channel == 0) then
	call msg_bug ("Compute seed kinematics: undefined integration channel")
	end if
	if (present (skip_term)) then
	skip_component = instance%term(skip_term)%config%i_component
	else
	skip_component = 0
	end if
	if (present (recover)) then
	if (recover) return
	end if
	if (instance%evaluation_status >= STAT_ACTIVATED) then
	success = .true.
	do i = 1, instance%process%get_n_components ()
	if (i == skip_component) cycle
	if (instance%process%component_is_selected (i)) then
	allocate (i_term (size (instance%process%get_component_i_terms (i))))
	i_term = instance%process%get_component_i_terms (i)
	do j = 1, size (i_term)
	associate (term => instance%term(i_term(j)), kin => instance%kin(i_term(j)))
	if (kin%new_seed) then
	call term%compute_seed_kinematics (kin, &
	instance%mci_work(instance%i_mci), channel, success)
	call instance%transfer_same_kinematics (i_term(j))
	end if
	if (.not. success) exit
	select type (pcm => instance%pcm)
	class is (pcm_nlo_t)
	call term%evaluate_projections (kin)
	call kin%evaluate_radiation_kinematics &
	(instance%mci_work(instance%i_mci)%get_x_process ())
	call kin%generate_fsr_in ()
	call kin%compute_xi_ref_momenta (pcm%region_data, term%nlo_type)
	end select
	end associate
	end do
	end if
	if (allocated (i_term)) deallocate (i_term)
	end do
	if (success) then
	instance%evaluation_status = STAT_SEED_KINEMATICS
	else
	instance%evaluation_status = STAT_FAILED_KINEMATICS
	end if
	end if
	associate (mci_work => instance%mci_work(instance%i_mci))
	select type (pcm_work => instance%pcm_work)
	class is (pcm_nlo_workspace_t)
	call pcm_work%set_x_rad (mci_work%get_x_process ())
	end select
	end associate
	end subroutine process_instance_compute_seed_kinematics

	@ %def process_instance_compute_seed_kinematics
	@
	<<Instances: process instance: TBP>>=
	procedure :: get_x_process => process_instance_get_x_process
	<<Instances: sub interfaces>>=
	pure module function process_instance_get_x_process (instance) result (x)
	real(default), dimension(:), allocatable :: x
	class(process_instance_t), intent(in) :: instance
	end function process_instance_get_x_process
	<<Instances: procedures>>=
	pure module function process_instance_get_x_process (instance) result (x)
	real(default), dimension(:), allocatable :: x
	class(process_instance_t), intent(in) :: instance
	allocate (x(size (instance%mci_work(instance%i_mci)%get_x_process ())))
	x = instance%mci_work(instance%i_mci)%get_x_process ()
	end function process_instance_get_x_process

	@ %def process_instance_get_x_process
	@
	<<Instances: process instance: TBP>>=
	procedure :: get_active_component_type => &
	process_instance_get_active_component_type
	<<Instances: sub interfaces>>=
	pure module function process_instance_get_active_component_type &
	(instance) result (nlo_type)
	integer :: nlo_type
	class(process_instance_t), intent(in) :: instance
	end function process_instance_get_active_component_type
	<<Instances: procedures>>=
	pure module function process_instance_get_active_component_type &
	(instance) result (nlo_type)
	integer :: nlo_type
	class(process_instance_t), intent(in) :: instance
	nlo_type = instance%process%get_component_nlo_type (instance%i_mci)
	end function process_instance_get_active_component_type

	@ %def process_instance_get_active_component_type
	@ Inverse: recover missing parts of the kinematics from the momentum
	configuration, which we know for a single term and component. Given
	a channel, reconstruct the MC parameter set.
	<<Instances: process instance: TBP>>=
	procedure :: recover_mcpar => process_instance_recover_mcpar
	<<Instances: sub interfaces>>=
	module subroutine process_instance_recover_mcpar (instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	end subroutine process_instance_recover_mcpar
	<<Instances: procedures>>=
	module subroutine process_instance_recover_mcpar (instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	integer :: channel, i
	if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
	channel = instance%selected_channel
	if (channel == 0) then
	call msg_bug ("Recover MC parameters: undefined integration channel")
	end if
	call instance%kin(i_term)%recover_mcpar &
	(instance%mci_work(instance%i_mci), channel, instance%term(i_term)%p_seed)
	if (instance%term(i_term)%nlo_type == NLO_REAL) then
	do i = 1, size (instance%term)
	if (i /= i_term .and. instance%term(i)%nlo_type == NLO_REAL) then
	if (instance%term(i)%active) then
	call instance%kin(i)%recover_mcpar &
	(instance%mci_work(instance%i_mci), channel, &
	instance%term(i)%p_seed)
	end if
	end if
	end do
	end if
	end if
	end subroutine process_instance_recover_mcpar

	@ %def process_instance_recover_mcpar
	@ This is part of [[recover_mcpar]], extracted for the case when there is
	no phase space and parameters to recover, but we still need the structure
	function kinematics for evaluation.
	<<Instances: process instance: TBP>>=
	procedure :: recover_sfchain => process_instance_recover_sfchain
	<<Instances: sub interfaces>>=
	module subroutine process_instance_recover_sfchain (instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	end subroutine process_instance_recover_sfchain
	<<Instances: procedures>>=
	module subroutine process_instance_recover_sfchain (instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	integer :: channel
	if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
	channel = instance%selected_channel
	if (channel == 0) then
	call msg_bug ("Recover sfchain: undefined integration channel")
	end if
	call instance%kin(i_term)%recover_sfchain &
	(channel, instance%term(i_term)%p_seed)
	end if
	end subroutine process_instance_recover_sfchain

	@ %def process_instance_recover_sfchain
	@ Second step of process evaluation: compute all momenta, for all active
	components, from the seed kinematics.
	<<Instances: process instance: TBP>>=
	procedure :: compute_hard_kinematics => &
	process_instance_compute_hard_kinematics
	<<Instances: sub interfaces>>=
	module subroutine process_instance_compute_hard_kinematics &
	(instance, recover, skip_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in), optional :: skip_term
	logical, intent(in), optional :: recover
	end subroutine process_instance_compute_hard_kinematics
	<<Instances: procedures>>=
	module subroutine process_instance_compute_hard_kinematics &
	(instance, recover, skip_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in), optional :: skip_term
	logical, intent(in), optional :: recover
	integer :: i
	logical :: success
	success = .true.
	if (instance%evaluation_status >= STAT_SEED_KINEMATICS) then
	do i = 1, size (instance%term)
	associate (term => instance%term(i), kin => instance%kin(i))
	if (term%active) then
	call term%compute_hard_kinematics &
	(kin, recover, skip_term, success)
	if (.not. success) exit
	!!! Ren scale is zero when this is commented out! Understand!
	if (term%nlo_type == NLO_REAL) &
	call kin%redo_sf_chain (instance%mci_work(instance%i_mci), &
	instance%selected_channel)
	end if
	end associate
	end do
	if (success) then
	instance%evaluation_status = STAT_HARD_KINEMATICS
	else
	instance%evaluation_status = STAT_FAILED_KINEMATICS
	end if
	end if
	end subroutine process_instance_compute_hard_kinematics

	@ %def process_instance_setup_compute_hard_kinematics
	@ Inverse: recover seed kinematics. We know the beam momentum
	configuration and the outgoing momenta of the effective interaction,
	for one specific term.
	<<Instances: process instance: TBP>>=
	procedure :: recover_seed_kinematics => &
	process_instance_recover_seed_kinematics
	<<Instances: sub interfaces>>=
	module subroutine process_instance_recover_seed_kinematics &
	(instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	end subroutine process_instance_recover_seed_kinematics
	<<Instances: procedures>>=
	module subroutine process_instance_recover_seed_kinematics (instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	type(vector4_t), dimension(:), allocatable :: p_seed_ref
	integer :: i
	if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
	call instance%term(i_term)%recover_seed_kinematics (instance%kin(i_term))
	if (instance%term(i_term)%nlo_type == NLO_REAL) then
	allocate (p_seed_ref &
	(instance%term(i_term)%isolated%int_eff%get_n_out ()))
	p_seed_ref = instance%term(i_term)%isolated%int_eff%get_momenta &
	(outgoing = .true.)
	do i = 1, size (instance%term)
	if (i /= i_term .and. instance%term(i)%nlo_type == NLO_REAL) then
	if (instance%term(i)%active) then
	call instance%term(i)%recover_seed_kinematics &
	(instance%kin(i), p_seed_ref)
	end if
	end if
	end do
	end if
	end if
	end subroutine process_instance_recover_seed_kinematics

	@ %def process_instance_recover_seed_kinematics
	@ Third step of process evaluation: compute the effective momentum
	configurations, for all active terms, from the hard kinematics.
	<<Instances: process instance: TBP>>=
	procedure :: compute_eff_kinematics => &
	process_instance_compute_eff_kinematics
	<<Instances: sub interfaces>>=
	module subroutine process_instance_compute_eff_kinematics &
	(instance, skip_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in), optional :: skip_term
	end subroutine process_instance_compute_eff_kinematics
	<<Instances: procedures>>=
	module subroutine process_instance_compute_eff_kinematics &
	(instance, skip_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in), optional :: skip_term
	integer :: i
	if (instance%evaluation_status >= STAT_HARD_KINEMATICS) then
	do i = 1, size (instance%term)
	if (present (skip_term)) then
	if (i == skip_term) cycle
	end if
	if (instance%term(i)%active) then
	call instance%term(i)%compute_eff_kinematics ()
	end if
	end do
	instance%evaluation_status = STAT_EFF_KINEMATICS
	end if
	end subroutine process_instance_compute_eff_kinematics

	@ %def process_instance_setup_compute_eff_kinematics
	@ Inverse: recover the hard kinematics from effective kinematics for
	one term, then compute effective kinematics for the other terms.
	<<Instances: process instance: TBP>>=
	procedure :: recover_hard_kinematics => &
	process_instance_recover_hard_kinematics
	<<Instances: sub interfaces>>=
	module subroutine process_instance_recover_hard_kinematics &
	(instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	end subroutine process_instance_recover_hard_kinematics
	<<Instances: procedures>>=
	module subroutine process_instance_recover_hard_kinematics (instance, i_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	integer :: i
	if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
	call instance%term(i_term)%recover_hard_kinematics ()
	do i = 1, size (instance%term)
	if (i /= i_term) then
	if (instance%term(i)%active) then
	call instance%term(i)%compute_eff_kinematics ()
	end if
	end if
	end do
	instance%evaluation_status = STAT_EFF_KINEMATICS
	end if
	end subroutine process_instance_recover_hard_kinematics

	@ %def recover_hard_kinematics
	@ Fourth step of process evaluation: check cuts for all terms. Where
	successful, compute any scales and weights. Otherwise, deactive the term.
	If any of the terms has passed, set the state to [[STAT_PASSED_CUTS]].

	The argument [[scale_forced]], if present, will override the scale calculation
	in the term expressions.
	<<Instances: process instance: TBP>>=
	procedure :: evaluate_expressions => &
	process_instance_evaluate_expressions
	<<Instances: sub interfaces>>=
	module subroutine process_instance_evaluate_expressions &
	(instance, scale_forced)
	class(process_instance_t), intent(inout) :: instance
	real(default), intent(in), allocatable, optional :: scale_forced
	end subroutine process_instance_evaluate_expressions
	<<Instances: procedures>>=
	module subroutine process_instance_evaluate_expressions &
	(instance, scale_forced)
	class(process_instance_t), intent(inout) :: instance
	real(default), intent(in), allocatable, optional :: scale_forced
	integer :: i
	logical :: passed_real
	if (instance%evaluation_status >= STAT_EFF_KINEMATICS) then
	do i = 1, size (instance%term)
	if (instance%term(i)%active) then
	call instance%term(i)%evaluate_expressions &
	(instance%process%get_beam_config (), scale_forced)
	end if
	end do
	call evaluate_real_scales_and_cuts ()
	call set_ellis_sexton_scale ()
	if (.not. passed_real) then
	instance%evaluation_status = STAT_FAILED_CUTS
	else
	if (any (instance%term%passed)) then
	instance%evaluation_status = STAT_PASSED_CUTS
	else
	instance%evaluation_status = STAT_FAILED_CUTS
	end if
	end if
	end if
	contains
	subroutine evaluate_real_scales_and_cuts ()
	integer :: i
	passed_real = .true.
	select type (pcm => instance%pcm)
	type is (pcm_nlo_t)
	do i = 1, size (instance%term)
	if (instance%term(i)%active .and. instance%term(i)%nlo_type == NLO_REAL) then
	if (pcm%settings%cut_all_real_sqmes) &
	passed_real = passed_real .and. instance%term(i)%passed
	if (pcm%settings%use_born_scale) &
	call replace_scales (instance%term(i))
	end if
	end do
	end select
	end subroutine evaluate_real_scales_and_cuts

	subroutine replace_scales (this_term)
	type(term_instance_t), intent(inout) :: this_term
	integer :: i_sub
	i_sub = this_term%config%i_sub
	if (this_term%config%i_term_global /= i_sub .and. i_sub > 0) then
	this_term%ren_scale = instance%term(i_sub)%ren_scale
	this_term%fac_scale = instance%term(i_sub)%fac_scale
	end if
	end subroutine replace_scales

	subroutine set_ellis_sexton_scale ()
	real(default) :: es_scale
	type(var_list_t), pointer :: var_list
	integer :: i
	var_list => instance%process%get_var_list_ptr ()
	es_scale = var_list%get_rval (var_str ("ellis_sexton_scale"))
	do i = 1, size (instance%term)
	if (instance%term(i)%active .and. instance%term(i)%nlo_type == NLO_VIRTUAL) then
	if (es_scale > zero) then
	if (allocated (instance%term(i)%es_scale)) then
	instance%term(i)%es_scale = es_scale
	else
	allocate (instance%term(i)%es_scale, source=es_scale)
	end if
	end if
	end if
	end do
	end subroutine set_ellis_sexton_scale
	end subroutine process_instance_evaluate_expressions

	@ %def process_instance_evaluate_expressions
	@ Fifth step of process evaluation: fill the parameters for the non-selected
	channels, that have not been used for seeding. We should do this after
	evaluating cuts, since we may save some expensive calculations if the phase
	space point fails the cuts.

	If [[skip_term]] is set, we skip the component that accesses this
	term. We can assume that the associated data have already been
	recovered, and we are just computing the rest.
	<<Instances: process instance: TBP>>=
	procedure :: compute_other_channels => &
	process_instance_compute_other_channels
	<<Instances: sub interfaces>>=
	module subroutine process_instance_compute_other_channels &
	(instance, skip_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in), optional :: skip_term
	end subroutine process_instance_compute_other_channels
	<<Instances: procedures>>=
	module subroutine process_instance_compute_other_channels &
	(instance, skip_term)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in), optional :: skip_term
	integer :: channel, skip_component, i, j
	integer, dimension(:), allocatable :: i_term
	channel = instance%selected_channel
	if (channel == 0) then
	call msg_bug ("Compute other channels: undefined integration channel")
	end if
	if (present (skip_term)) then
	skip_component = instance%term(skip_term)%config%i_component
	else
	skip_component = 0
	end if
	if (instance%evaluation_status >= STAT_PASSED_CUTS) then
	do i = 1, instance%process%get_n_components ()
	if (i == skip_component) cycle
	if (instance%process%component_is_selected (i)) then
	allocate (i_term (size (instance%process%get_component_i_terms (i))))
	i_term = instance%process%get_component_i_terms (i)
	do j = 1, size (i_term)
	call instance%kin(i_term(j))%compute_other_channels &
	(instance%mci_work(instance%i_mci), channel)
	end do
	end if
	if (allocated (i_term)) deallocate (i_term)
	end do
	end if
	end subroutine process_instance_compute_other_channels

	@ %def process_instance_compute_other_channels
	@ If not done otherwise, we flag the kinematics as new for the core state,
	such that the routine below will actually compute the matrix element and not
	just look it up.
	<<Instances: process instance: TBP>>=
	procedure :: reset_core_kinematics => process_instance_reset_core_kinematics
	<<Instances: sub interfaces>>=
	module subroutine process_instance_reset_core_kinematics (instance)
	class(process_instance_t), intent(inout) :: instance
	end subroutine process_instance_reset_core_kinematics
	<<Instances: procedures>>=
	module subroutine process_instance_reset_core_kinematics (instance)
	class(process_instance_t), intent(inout) :: instance
	integer :: i
	if (instance%evaluation_status >= STAT_PASSED_CUTS) then
	do i = 1, size (instance%term)
	associate (term => instance%term(i))
	if (term%active .and. term%passed) then
	if (allocated (term%core_state)) &
	call term%core_state%reset_new_kinematics ()
	end if
	end associate
	end do
	end if
	end subroutine process_instance_reset_core_kinematics

	@ %def process_instance_reset_core_kinematics
	@ Sixth step of process evaluation: evaluate the matrix elements, and compute
	the trace (summed over quantum numbers) for all terms. Finally, sum up the
	terms, iterating over all active process components.
	<<Instances: process instance: TBP>>=
	procedure :: evaluate_trace => process_instance_evaluate_trace
	<<Instances: sub interfaces>>=
	module subroutine process_instance_evaluate_trace (instance, recover)
	class(process_instance_t), intent(inout) :: instance
	logical, intent(in), optional :: recover
	end subroutine process_instance_evaluate_trace
	<<Instances: procedures>>=
	module subroutine process_instance_evaluate_trace (instance, recover)
	class(process_instance_t), intent(inout) :: instance
	logical, intent(in), optional :: recover
	class(prc_core_t), pointer :: core => null ()
	integer :: i, i_real_fin, i_core, i_qn, i_flv
	real(default) :: alpha_s, alpha_qed, pt
	class(prc_core_t), pointer :: core_sub => null ()
	class(model_data_t), pointer :: model => null ()
	logical :: has_pdfs
	if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "process_instance_evaluate_trace")
	has_pdfs = instance%process%pcm_contains_pdfs ()
	instance%sqme = zero
	select type (pcm_work => instance%pcm_work)
	type is (pcm_nlo_workspace_t)
	if (allocated(pcm_work%real_sub%sqme_real_arr)) then
	pcm_work%real_sub%sqme_real_arr = zero
	end if
	end select
	call instance%reset_matrix_elements ()
	if (instance%evaluation_status >= STAT_PASSED_CUTS) then
	do i = 1, size (instance%term)
	associate (term => instance%term(i), kin => instance%kin(i))
	if (term%active .and. term%passed) then
	core => instance%process%get_core_term (i)
	select type (pcm => instance%process%get_pcm_ptr ())
	class is (pcm_nlo_t)
	i_core = pcm%get_i_core (pcm%i_sub)
	core_sub => instance%process%get_core_ptr (i_core)
	end select
	call term%evaluate_interaction (core, kin)
	call term%evaluate_trace (kin)
	i_real_fin = instance%process%get_associated_real_fin (1)
	if (instance%process%uses_real_partition ()) &
	call term%apply_real_partition (kin)
	if (term%config%i_component == i_real_fin) then
	if (term%nlo_type == NLO_REAL .and. .not. term%is_subtraction ()) then
	!!! Force the scale pT into the events for the real finite
	associate (p_hard => term%p_hard)
	!!! This is only the correct pt for ISR
	pt = transverse_part(p_hard(size(p_hard)))
	call term%set_fac_scale (pt)
	select type (core)
	class is (prc_external_t)
	select type (core_state => term%core_state)
	class is (prc_external_state_t)
	core_state%alpha_qcd = core%qcd%alpha%get (pt)
	end select
	type is (prc_omega_t)
	select type (core_state => term%core_state)
	type is (omega_state_t)
	core_state%alpha_qcd = core%qcd%alpha%get (pt)
	end select
	end select
	end associate
	end if
	else
	if (term%nlo_type == BORN) then
	do i_flv = 1, term%connected%trace%get_qn_index_n_flv ()
	i_qn = term%connected%trace%get_qn_index (i_flv, i_sub = 0)
	if (.not. term%passed_array(i_flv)) then
	call term%connected%trace%set_matrix_element &
	(i_qn, cmplx (zero, zero, default))
	end if
	end do
	end if
	if ((term%nlo_type == NLO_REAL .and. kin%emitter < 0) &
	.or. term%nlo_type == NLO_MISMATCH &
	.or. term%nlo_type == NLO_DGLAP) &
	call term%set_born_sqmes (core)
	if (term%is_subtraction () .or. &
	term%nlo_type == NLO_DGLAP) &
	call term%set_sf_factors (kin, has_pdfs)
	if (term%nlo_type > BORN) then
	if (.not. (term%nlo_type == NLO_REAL .and. &
	kin%emitter >= 0)) then
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	if (char (pcm%settings%nlo_correction_type) == "QCD" .or. &
	char (pcm%settings%nlo_correction_type) == "Full") &
	call term%evaluate_color_correlations (core_sub)
	if (char (pcm%settings%nlo_correction_type) == "EW" .or. &
	char (pcm%settings%nlo_correction_type) == "Full") then
	call term%evaluate_charge_correlations (core_sub)
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	associate (reg_data => pcm%region_data)
	if (reg_data%alphas_power > 0) &
	call term%evaluate_color_correlations (core_sub)
	end associate
	end select
	end if
	end select
	end if
	if (term%is_subtraction ()) then
	call term%evaluate_spin_correlations (core_sub)
	end if
	end if
	alpha_s = core%get_alpha_s (term%core_state)
	alpha_qed = core%get_alpha_qed (term%core_state)
	if (term%nlo_type > BORN) then
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	if (alpha_qed == -1 .and. (&
	char (pcm%settings%nlo_correction_type) == "EW" .or. &
	char (pcm%settings%nlo_correction_type) == "Full")) then
	call msg_bug("Attempting to compute EW corrections with alpha_qed = -1")
	end if
	end select
	end if
	if (present (recover)) then
	if (recover) return
	end if
	select case (term%nlo_type)
	case (NLO_REAL)
	call term%apply_fks (kin, alpha_s, alpha_qed)
	case (NLO_VIRTUAL)
	call term%evaluate_sqme_virt (alpha_s, alpha_qed)
	case (NLO_MISMATCH)
	call term%evaluate_sqme_mismatch (alpha_s)
	case (NLO_DGLAP)
	call term%evaluate_sqme_dglap (alpha_s, alpha_qed)
	end select
	end if
	end if
	core_sub => null ()
	instance%sqme = instance%sqme + real (sum (&
	term%connected%trace%get_matrix_element () * &
	term%weight))
	end associate
	end do
	core => null ()
	if (instance%pcm_work%is_valid ()) then
	instance%evaluation_status = STAT_EVALUATED_TRACE
	else
	instance%evaluation_status = STAT_FAILED_KINEMATICS
	end if
	else
	!!! Failed kinematics or failed cuts: set sqme to zero
	instance%sqme = zero
	end if
	end subroutine process_instance_evaluate_trace

	@ %def process_instance_evaluate_trace
	<<Instances: term instance: TBP>>=
	procedure :: set_born_sqmes => term_instance_set_born_sqmes
	<<Instances: sub interfaces>>=
	module subroutine term_instance_set_born_sqmes (term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(in) :: core
	end subroutine term_instance_set_born_sqmes
	<<Instances: procedures>>=
	module subroutine term_instance_set_born_sqmes (term, core)
	class(term_instance_t), intent(inout) :: term
	class(prc_core_t), intent(in) :: core
	integer :: i_flv, ii_flv
	real(default) :: sqme
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	do i_flv = 1, term%connected%trace%get_qn_index_n_flv ()
	ii_flv = term%connected%trace%get_qn_index (i_flv, i_sub = 0)
	if (term%passed_array (i_flv) .or. .not. term%passed) then
	sqme = real (term%connected%trace%get_matrix_element (ii_flv))
	else
	sqme = zero
	end if
	select case (term%nlo_type)
	case (NLO_REAL)
	pcm_work%real_sub%sqme_born(i_flv) = sqme
	case (NLO_MISMATCH)
	pcm_work%soft_mismatch%sqme_born(i_flv) = sqme
	case (NLO_DGLAP)
	pcm_work%dglap_remnant%sqme_born(i_flv) = sqme
	end select
	end do
	end select
	end subroutine term_instance_set_born_sqmes

	@ %def term_instance_set_born_sqmes
	@ Calculates and then saves the ratio of the value of the (rescaled) real
	structure function chain of each ISR alpha region over the value of the
	corresponding underlying born flavor structure. In the case of emitter
	0 we also need the rescaled ratio for emitter 1 and 2 in that region
	for the (soft-)collinear limits. If the emitter is 1 or 2 in some
	cases, e. g. for EW corrections where a photon in the proton is
	required, there can be the possibility of soft radiation off the
	initial state. For that purpose the unrescaled ratio is needed and as
	a default we always save these numbers in [[sf_factors(:,0)]]. Although
	this procedure is implying functionality for general structure functions,
	it should be reviewed for anything else besides PDFs, as there might
	be complications in the details. The general idea of getting the ratio
	in this way should hold up in these cases as well, however.
	<<Instances: term instance: TBP>>=
	procedure :: set_sf_factors => term_instance_set_sf_factors
	<<Instances: sub interfaces>>=
	module subroutine term_instance_set_sf_factors (term, kin, has_pdfs)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(inout) :: kin
	logical, intent(in) :: has_pdfs
	end subroutine term_instance_set_sf_factors
	<<Instances: procedures>>=
	module subroutine term_instance_set_sf_factors (term, kin, has_pdfs)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(inout) :: kin
	logical, intent(in) :: has_pdfs
	type(interaction_t), pointer :: sf_chain_int
	real(default) :: factor_born, factor_real
	integer :: n_in, alr, em
	integer :: i_born, i_real
	select type (pcm_work => term%pcm_work)
	type is (pcm_nlo_workspace_t)
	if (.not. has_pdfs) then
	pcm_work%real_sub%sf_factors = one
	return
	end if
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	sf_chain_int => kin%sf_chain%get_out_int_ptr ()
	associate (reg_data => pcm%region_data)
	n_in = reg_data%get_n_in ()
	do alr = 1, reg_data%n_regions
	em = reg_data%regions(alr)%emitter
	if (em <= n_in) then
	i_born = reg_data%regions(alr)%uborn_index
	i_real = reg_data%regions(alr)%real_index
	factor_born = sf_chain_int%get_matrix_element &
	(sf_chain_int%get_sf_qn_index_born (i_born, i_sub = 0))
	factor_real = sf_chain_int%get_matrix_element &
	(sf_chain_int%get_sf_qn_index_real (i_real, i_sub = em))
	call set_factor (pcm_work, alr, em, factor_born, factor_real)
	if (em == 0) then
	do em = 1, 2
	factor_real = sf_chain_int%get_matrix_element &
	(sf_chain_int%get_sf_qn_index_real (i_real, i_sub = em))
	call set_factor (pcm_work, alr, em, factor_born, factor_real)
	end do
	else
	factor_real = sf_chain_int%get_matrix_element &
	(sf_chain_int%get_sf_qn_index_real (i_real, i_sub = 0))
	call set_factor (pcm_work, alr, 0, factor_born, factor_real)
	end if
	end if
	end do
	end associate
	end select
	end select
	contains
	subroutine set_factor (pcm_work, alr, em, factor_born, factor_real)
	type(pcm_nlo_workspace_t), intent(inout), target :: pcm_work
	integer, intent(in) :: alr, em
	real(default), intent(in) :: factor_born, factor_real
	real(default) :: factor
	if (any (vanishes ([factor_real, factor_born], tiny(1._default), tiny(1._default)))) then
	factor = zero
	else
	factor = factor_real / factor_born
	end if
	select case (term%nlo_type)
	case (NLO_REAL)
	pcm_work%real_sub%sf_factors(alr, em) = factor
	case (NLO_DGLAP)
	pcm_work%dglap_remnant%sf_factors(alr, em) = factor
	end select
	end subroutine
	end subroutine term_instance_set_sf_factors

	@ %def term_instance_set_sf_factors
	@
	<<Instances: process instance: TBP>>=
	procedure :: apply_real_partition => process_instance_apply_real_partition
	<<Instances: sub interfaces>>=
	module subroutine process_instance_apply_real_partition (instance)
	class(process_instance_t), intent(inout) :: instance
	end subroutine process_instance_apply_real_partition
	<<Instances: procedures>>=
	module subroutine process_instance_apply_real_partition (instance)
	class(process_instance_t), intent(inout) :: instance
	integer :: i_component, i_term
	integer, dimension(:), allocatable :: i_terms
	associate (process => instance%process)
	i_component = process%get_first_real_component ()
	if (process%component_is_selected (i_component) .and. &
	process%get_component_nlo_type (i_component) == NLO_REAL) then
	allocate (i_terms, source=process%get_component_i_terms (i_component))
	do i_term = 1, size (i_terms)
	call instance%term(i_terms(i_term))%apply_real_partition ( &
	instance%kin(i_terms(i_term)))
	end do
	end if
	if (allocated (i_terms)) deallocate (i_terms)
	end associate
	end subroutine process_instance_apply_real_partition

	@ %def process_instance_apply_real_partition
	@
	<<Instances: process instance: TBP>>=
	procedure :: set_i_mci_to_real_component => &
	process_instance_set_i_mci_to_real_component
	<<Instances: sub interfaces>>=
	module subroutine process_instance_set_i_mci_to_real_component (instance)
	class(process_instance_t), intent(inout) :: instance
	end subroutine process_instance_set_i_mci_to_real_component
	<<Instances: procedures>>=
	module subroutine process_instance_set_i_mci_to_real_component (instance)
	class(process_instance_t), intent(inout) :: instance
	integer :: i_mci, i_component
	type(process_component_t), pointer :: component => null ()
	select type (pcm_work => instance%pcm_work)
	type is (pcm_nlo_workspace_t)
	if (allocated (pcm_work%i_mci_to_real_component)) then
	call msg_warning &
	("i_mci_to_real_component already allocated - replace it")
	deallocate (pcm_work%i_mci_to_real_component)
	end if
	allocate (pcm_work%i_mci_to_real_component (size (instance%mci_work)))
	do i_mci = 1, size (instance%mci_work)
	do i_component = 1, instance%process%get_n_components ()
	component => instance%process%get_component_ptr (i_component)
	if (component%i_mci /= i_mci) cycle
	select case (component%component_type)
	case (COMP_MASTER, COMP_REAL)
	pcm_work%i_mci_to_real_component (i_mci) = &
	component%config%get_associated_real ()
	case (COMP_REAL_FIN)
	pcm_work%i_mci_to_real_component (i_mci) = &
	component%config%get_associated_real_fin ()
	case (COMP_REAL_SING)
	pcm_work%i_mci_to_real_component (i_mci) = &
	component%config%get_associated_real_sing ()
	end select
	end do
	end do
	component => null ()
	end select
	end subroutine process_instance_set_i_mci_to_real_component

	@ %def process_instance_set_i_mci_to_real_component
	@ Final step of process evaluation: evaluate the matrix elements, and compute
	the trace (summed over quantum numbers) for all terms. Finally, sum up the
	terms, iterating over all active process components.

	If [[weight]] is provided, we already know the kinematical event
	weight (the MCI weight which depends on the kinematics sampling
	algorithm, but not on the matrix element), so we do not need to take
	it from the MCI record.
	<<Instances: process instance: TBP>>=
	procedure :: evaluate_event_data => process_instance_evaluate_event_data
	<<Instances: sub interfaces>>=
	module subroutine process_instance_evaluate_event_data (instance, weight)
	class(process_instance_t), intent(inout) :: instance
	real(default), intent(in), optional :: weight
	end subroutine process_instance_evaluate_event_data
	<<Instances: procedures>>=
	module subroutine process_instance_evaluate_event_data (instance, weight)
	class(process_instance_t), intent(inout) :: instance
	real(default), intent(in), optional :: weight
	integer :: i
	if (instance%evaluation_status >= STAT_EVALUATED_TRACE) then
	do i = 1, size (instance%term)
	associate (term => instance%term(i))
	if (term%active) then
	call term%evaluate_event_data ()
	end if
	end associate
	end do
	if (present (weight)) then
	instance%weight = weight
	else
	instance%weight = &
	instance%mci_work(instance%i_mci)%mci%get_event_weight ()
	instance%excess = &
	instance%mci_work(instance%i_mci)%mci%get_event_excess ()
	end if
	instance%n_dropped = &
	instance%mci_work(instance%i_mci)%mci%get_n_event_dropped ()
	instance%evaluation_status = STAT_EVENT_COMPLETE
	else
	!!! failed kinematics etc.: set weight to zero
	instance%weight = zero
	!!! Maybe we want to process and keep the event nevertheless
	if (instance%keep_failed_events ()) then
	do i = 1, size (instance%term)
	associate (term => instance%term(i))
	if (term%active) then
	call term%evaluate_event_data ()
	end if
	end associate
	end do
	! do i = 1, size (instance%term)
	! instance%term(i)%fac_scale = zero
	! end do
	instance%evaluation_status = STAT_EVENT_COMPLETE
	end if
	end if
	end subroutine process_instance_evaluate_event_data

	@ %def process_instance_evaluate_event_data
	@ Computes the real-emission matrix element for externally supplied momenta
	for the term instance with index [[i_term]] and a phase space point set with
	index [[i_phs]]. In addition, for the real emission, each term instance
	corresponds to one emitter. There is the possibility to supply an external
	$\alpha_s$ as well as an external scale to override the scale set in the
	Sindarin, e.g. for POWHEG matching.
	<<Instances: process instance: TBP>>=
	procedure :: compute_sqme_rad => process_instance_compute_sqme_rad
	<<Instances: sub interfaces>>=
	module subroutine process_instance_compute_sqme_rad (instance, &
	i_term, i_phs, is_subtraction, alpha_s_external, scale_forced)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term, i_phs
	logical, intent(in) :: is_subtraction
	real(default), intent(in), optional :: alpha_s_external
	real(default), intent(in), allocatable, optional :: scale_forced
	end subroutine process_instance_compute_sqme_rad
	<<Instances: procedures>>=
	module subroutine process_instance_compute_sqme_rad (instance, &
	i_term, i_phs, is_subtraction, alpha_s_external, scale_forced)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term, i_phs
	logical, intent(in) :: is_subtraction
	real(default), intent(in), optional :: alpha_s_external
	real(default), intent(in), allocatable, optional :: scale_forced
	class(prc_core_t), pointer :: core
	integer :: i_real_fin
	logical :: has_pdfs
	has_pdfs = instance%process%pcm_contains_pdfs ()
	select type (pcm_work => instance%pcm_work)
	type is (pcm_nlo_workspace_t)
	if (allocated(pcm_work%real_sub%sqme_real_arr)) then
	pcm_work%real_sub%sqme_real_arr = zero
	end if
	end select
	if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "process_instance_compute_sqme_rad")
	select type (pcm_work => instance%pcm_work)
	type is (pcm_nlo_workspace_t)
	associate (term => instance%term(i_term), kin => instance%kin(i_term))
	core => instance%process%get_core_term (i_term)
	if (is_subtraction) then
	call pcm_work%set_subtraction_event ()
	else
	call pcm_work%set_radiation_event ()
	end if
	call term%int_hard%set_momenta (pcm_work%get_momenta &
	(term%pcm, i_phs = i_phs, born_phsp = is_subtraction))
	if (allocated (term%core_state)) &
	call term%core_state%reset_new_kinematics ()
	if (present (alpha_s_external)) then
	call term%set_alpha_qcd_forced (alpha_s_external)
	end if
	call term%compute_eff_kinematics ()
	call term%evaluate_expressions &
	(instance%process%get_beam_config (), scale_forced)
	call term%evaluate_interaction (core, kin)
	call term%evaluate_trace (kin)
	if (term%is_subtraction ()) then
	call term%set_sf_factors (kin, has_pdfs)
	select type (pcm => instance%pcm)
	type is (pcm_nlo_t)
	if (char (pcm%settings%nlo_correction_type) == "QCD" .or. &
	char (pcm%settings%nlo_correction_type) == "Full") &
	call term%evaluate_color_correlations (core)
	if (char (pcm%settings%nlo_correction_type) == "EW" .or. &
	char (pcm%settings%nlo_correction_type) == "Full") &
	call term%evaluate_charge_correlations (core)
	end select
	call term%evaluate_spin_correlations (core)
	end if
	i_real_fin = instance%process%get_associated_real_fin (1)
	if (term%config%i_component /= i_real_fin) &
	call term%apply_fks (kin, core%get_alpha_s (term%core_state), &
	core%get_alpha_qed (term%core_state))
	if (instance%process%uses_real_partition ()) &
	call instance%apply_real_partition ()
	end associate
	end select
	core => null ()
	end subroutine process_instance_compute_sqme_rad

	@ %def process_instance_compute_sqme_rad
	@ For unweighted event generation, we should reset the reported event
	weight to unity (signed) or zero. The latter case is appropriate for
	an event which failed for whatever reason.
	<<Instances: process instance: TBP>>=
	procedure :: normalize_weight => process_instance_normalize_weight
	<<Instances: sub interfaces>>=
	module subroutine process_instance_normalize_weight (instance)
	class(process_instance_t), intent(inout) :: instance
	end subroutine process_instance_normalize_weight
	<<Instances: procedures>>=
	module subroutine process_instance_normalize_weight (instance)
	class(process_instance_t), intent(inout) :: instance
	if (.not. vanishes (instance%weight)) then
	instance%weight = sign (1._default, instance%weight)
	end if
	end subroutine process_instance_normalize_weight

	@ %def process_instance_normalize_weight
	@ This is a convenience routine that performs the computations of the
	steps 1 to 5 in a single step. The arguments are the input for
	[[set_mcpar]]. After this, the evaluation status should be either
	[[STAT_FAILED_KINEMATICS]], [[STAT_FAILED_CUTS]] or [[STAT_EVALUATED_TRACE]].

	Before calling this, we should call [[choose_mci]].
	<<Instances: process instance: TBP>>=
	procedure :: evaluate_sqme => process_instance_evaluate_sqme
	<<Instances: sub interfaces>>=
	module subroutine process_instance_evaluate_sqme (instance, channel, x)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: channel
	real(default), dimension(:), intent(in) :: x
	end subroutine process_instance_evaluate_sqme
	<<Instances: procedures>>=
	module subroutine process_instance_evaluate_sqme (instance, channel, x)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: channel
	real(default), dimension(:), intent(in) :: x
	call instance%reset ()
	call instance%set_mcpar (x)
	call instance%select_channel (channel)
	call instance%compute_seed_kinematics ()
	call instance%compute_hard_kinematics ()
	call instance%compute_eff_kinematics ()
	call instance%evaluate_expressions ()
	call instance%compute_other_channels ()
	call instance%evaluate_trace ()
	end subroutine process_instance_evaluate_sqme

	@ %def process_instance_evaluate_sqme
	@ This is the inverse. Assuming that the final trace evaluator
	contains a valid momentum configuration, recover kinematics
	and recalculate the matrix elements and their trace.

	To be precise, we first recover kinematics for the given term and
	associated component, then recalculate from that all other terms and
	active components. The [[channel]] is not really required to obtain
	the matrix element, but it allows us to reconstruct the exact MC
	parameter set that corresponds to the given phase space point.

	Before calling this, we should call [[choose_mci]].
	<<Instances: process instance: TBP>>=
	procedure :: recover => process_instance_recover
	<<Instances: sub interfaces>>=
	module subroutine process_instance_recover &
	(instance, channel, i_term, update_sqme, recover_phs, scale_forced)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: channel
	integer, intent(in) :: i_term
	logical, intent(in) :: update_sqme
	logical, intent(in) :: recover_phs
	real(default), intent(in), allocatable, optional :: scale_forced
	end subroutine process_instance_recover
	<<Instances: procedures>>=
	module subroutine process_instance_recover &
	(instance, channel, i_term, update_sqme, recover_phs, scale_forced)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: channel
	integer, intent(in) :: i_term
	logical, intent(in) :: update_sqme
	logical, intent(in) :: recover_phs
	real(default), intent(in), allocatable, optional :: scale_forced
	logical :: skip_phs, recover
	call instance%activate ()
	instance%evaluation_status = STAT_EFF_KINEMATICS
	call instance%recover_hard_kinematics (i_term)
	call instance%recover_seed_kinematics (i_term)
	call instance%select_channel (channel)
	recover = instance%pcm_work%is_nlo ()
	if (recover_phs) then
	call instance%recover_mcpar (i_term)
	call instance%recover_beam_momenta (i_term)
	call instance%compute_seed_kinematics &
	(recover = recover, skip_term = i_term)
	call instance%compute_hard_kinematics &
	(recover = recover, skip_term = i_term)
	call instance%compute_eff_kinematics (i_term)
	call instance%compute_other_channels (i_term)
	else
	call instance%recover_sfchain (i_term)
	end if
	call instance%evaluate_expressions (scale_forced)
	if (update_sqme) then
	call instance%reset_core_kinematics ()
	call instance%evaluate_trace (recover)
	end if
	end subroutine process_instance_recover

	@ %def process_instance_recover
	@ The [[evaluate]] method is required by the [[sampler_t]] base type of which
	the process instance is an extension.

	The requirement is that after the process instance is evaluated, the
	integrand, the selected channel, the $x$ array, and the $f$ Jacobian array are
	exposed by the [[sampler_t]] object.

	We allow for the additional [[hook]] to be called, if associated, for outlying
	object to access information from the current state of the [[sampler]].
	<<Instances: process instance: TBP>>=
	procedure :: evaluate => process_instance_evaluate
	<<Instances: sub interfaces>>=
	module subroutine process_instance_evaluate (sampler, c, x_in, val, x, f)
	class(process_instance_t), intent(inout) :: sampler
	integer, intent(in) :: c
	real(default), dimension(:), intent(in) :: x_in
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	end subroutine process_instance_evaluate
	<<Instances: procedures>>=
	module subroutine process_instance_evaluate (sampler, c, x_in, val, x, f)
	class(process_instance_t), intent(inout) :: sampler
	integer, intent(in) :: c
	real(default), dimension(:), intent(in) :: x_in
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	call sampler%evaluate_sqme (c, x_in)
	if (sampler%is_valid ()) then
	call sampler%fetch (val, x, f)
	end if
	call sampler%record_call ()
	call sampler%evaluate_after_hook ()
	end subroutine process_instance_evaluate

	@ %def process_instance_evaluate
	@ The phase-space point is valid if the event has valid kinematics and
	has passed the cuts.
	<<Instances: process instance: TBP>>=
	procedure :: is_valid => process_instance_is_valid
	<<Instances: sub interfaces>>=
	module function process_instance_is_valid (sampler) result (valid)
	class(process_instance_t), intent(in) :: sampler
	logical :: valid
	end function process_instance_is_valid
	<<Instances: procedures>>=
	module function process_instance_is_valid (sampler) result (valid)
	class(process_instance_t), intent(in) :: sampler
	logical :: valid
	valid = sampler%evaluation_status >= STAT_PASSED_CUTS
	end function process_instance_is_valid

	@ %def process_instance_is_valid
	@ Add a [[process_instance_hook]] object..
	<<Instances: process instance: TBP>>=
	procedure :: append_after_hook => process_instance_append_after_hook
	<<Instances: sub interfaces>>=
	module subroutine process_instance_append_after_hook (sampler, new_hook)
	class(process_instance_t), intent(inout), target :: sampler
	class(process_instance_hook_t), intent(inout), target :: new_hook
	end subroutine process_instance_append_after_hook
	<<Instances: procedures>>=
	module subroutine process_instance_append_after_hook (sampler, new_hook)
	class(process_instance_t), intent(inout), target :: sampler
	class(process_instance_hook_t), intent(inout), target :: new_hook
	class(process_instance_hook_t), pointer :: last
	if (associated (new_hook%next)) then
	call msg_bug ("process_instance_append_after_hook: " // &
	"reuse of SAME hook object is forbidden.")
	end if
	if (associated (sampler%hook)) then
	last => sampler%hook
	do while (associated (last%next))
	last => last%next
	end do
	last%next => new_hook
	else
	sampler%hook => new_hook
	end if
	end subroutine process_instance_append_after_hook

	@ %def process_instance_append_after_evaluate_hook
	@ Evaluate the after hook as first in, last out.
	<<Instances: process instance: TBP>>=
	procedure :: evaluate_after_hook => process_instance_evaluate_after_hook
	<<Instances: sub interfaces>>=
	module subroutine process_instance_evaluate_after_hook (sampler)
	class(process_instance_t), intent(in) :: sampler
	end subroutine process_instance_evaluate_after_hook
	<<Instances: procedures>>=
	module subroutine process_instance_evaluate_after_hook (sampler)
	class(process_instance_t), intent(in) :: sampler
	class(process_instance_hook_t), pointer :: current
	current => sampler%hook
	do while (associated(current))
	call current%evaluate (sampler)
	current => current%next
	end do
	end subroutine process_instance_evaluate_after_hook

	@ %def process_instance_evaluate_after_hook
	@ The [[rebuild]] method should rebuild the kinematics section out of
	the [[x_in]] parameter set. The integrand value [[val]] should not be
	computed, but is provided as input.
	<<Instances: process instance: TBP>>=
	procedure :: rebuild => process_instance_rebuild
	<<Instances: sub interfaces>>=
	module subroutine process_instance_rebuild (sampler, c, x_in, val, x, f)
	class(process_instance_t), intent(inout) :: sampler
	integer, intent(in) :: c
	real(default), dimension(:), intent(in) :: x_in
	real(default), intent(in) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	end subroutine process_instance_rebuild
	<<Instances: procedures>>=
	module subroutine process_instance_rebuild (sampler, c, x_in, val, x, f)
	class(process_instance_t), intent(inout) :: sampler
	integer, intent(in) :: c
	real(default), dimension(:), intent(in) :: x_in
	real(default), intent(in) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	call msg_bug ("process_instance_rebuild not implemented yet")
	x = 0
	f = 0
	end subroutine process_instance_rebuild

	@ %def process_instance_rebuild
	@ This is another method required by the [[sampler_t]] base type:
	fetch the data that are relevant for the MCI record.
	<<Instances: process instance: TBP>>=
	procedure :: fetch => process_instance_fetch
	<<Instances: sub interfaces>>=
	module subroutine process_instance_fetch (sampler, val, x, f)
	class(process_instance_t), intent(in) :: sampler
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	end subroutine process_instance_fetch
	<<Instances: procedures>>=
	module subroutine process_instance_fetch (sampler, val, x, f)
	class(process_instance_t), intent(in) :: sampler
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	integer, dimension(:), allocatable :: i_terms
	integer :: i, i_term_base, cc
	integer :: n_channel

	val = 0
	associate (process => sampler%process)
	FIND_COMPONENT: do i = 1, process%get_n_components ()
	if (sampler%process%component_is_selected (i)) then
	allocate (i_terms (size (process%get_component_i_terms (i))))
	i_terms = process%get_component_i_terms (i)
	i_term_base = i_terms(1)
	associate (k => sampler%kin(i_term_base))
	n_channel = k%n_channel
	do cc = 1, n_channel
	call k%get_mcpar (cc, x(:,cc))
	end do
	f = k%f
	val = sampler%sqme * k%phs_factor
	end associate
	if (allocated (i_terms)) deallocate (i_terms)
	exit FIND_COMPONENT
	end if
	end do FIND_COMPONENT
	end associate
	end subroutine process_instance_fetch

	@ %def process_instance_fetch
	@ Initialize and finalize event generation for the specified MCI
	entry.
	<<Instances: process instance: TBP>>=
	procedure :: init_simulation => process_instance_init_simulation
	procedure :: final_simulation => process_instance_final_simulation
	<<Instances: sub interfaces>>=
	module subroutine process_instance_init_simulation (instance, i_mci, &
	safety_factor, keep_failed_events)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	real(default), intent(in), optional :: safety_factor
	logical, intent(in), optional :: keep_failed_events
	end subroutine process_instance_init_simulation
	module subroutine process_instance_final_simulation (instance, i_mci)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	end subroutine process_instance_final_simulation
	<<Instances: procedures>>=
	module subroutine process_instance_init_simulation (instance, i_mci, &
	safety_factor, keep_failed_events)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	real(default), intent(in), optional :: safety_factor
	logical, intent(in), optional :: keep_failed_events
	call instance%mci_work(i_mci)%init_simulation &
	(safety_factor, keep_failed_events)
	end subroutine process_instance_init_simulation

	module subroutine process_instance_final_simulation (instance, i_mci)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_mci
	call instance%mci_work(i_mci)%final_simulation ()
	end subroutine process_instance_final_simulation

	@ %def process_instance_init_simulation
	@ %def process_instance_final_simulation
	@
	\subsubsection{Accessing the process instance}
	Once the seed kinematics is complete, we can retrieve the MC input parameters
	for all channels, not just the seed channel.

	Note: We choose the first active component. This makes sense only if the seed
	kinematics is identical for all active components.
	<<Instances: process instance: TBP>>=
	procedure :: get_mcpar => process_instance_get_mcpar
	<<Instances: sub interfaces>>=
	module subroutine process_instance_get_mcpar (instance, channel, x)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: channel
	real(default), dimension(:), intent(out) :: x
	end subroutine process_instance_get_mcpar
	<<Instances: procedures>>=
	module subroutine process_instance_get_mcpar (instance, channel, x)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: channel
	real(default), dimension(:), intent(out) :: x
	integer :: i
	if (instance%evaluation_status >= STAT_SEED_KINEMATICS) then
	do i = 1, size (instance%term)
	if (instance%term(i)%active) then
	call instance%kin(i)%get_mcpar (channel, x)
	return
	end if
	end do
	call msg_bug ("Process instance: get_mcpar: no active channels")
	else
	call msg_bug ("Process instance: get_mcpar: no seed kinematics")
	end if
	end subroutine process_instance_get_mcpar

	@ %def process_instance_get_mcpar
	@ Return true if the [[sqme]] value is known. This also implies that the
	event is kinematically valid and has passed all cuts.
	<<Instances: process instance: TBP>>=
	procedure :: has_evaluated_trace => process_instance_has_evaluated_trace
	<<Instances: sub interfaces>>=
	module function process_instance_has_evaluated_trace &
	(instance) result (flag)
	class(process_instance_t), intent(in) :: instance
	logical :: flag
	end function process_instance_has_evaluated_trace
	<<Instances: procedures>>=
	module function process_instance_has_evaluated_trace (instance) result (flag)
	class(process_instance_t), intent(in) :: instance
	logical :: flag
	flag = instance%evaluation_status >= STAT_EVALUATED_TRACE
	end function process_instance_has_evaluated_trace

	@ %def process_instance_has_evaluated_trace
	@ Return true if the event is complete. In particular, the event must
	be kinematically valid, passed all cuts, and the event data have been
	computed.
	<<Instances: process instance: TBP>>=
	procedure :: is_complete_event => process_instance_is_complete_event
	<<Instances: sub interfaces>>=
	module function process_instance_is_complete_event (instance) result (flag)
	class(process_instance_t), intent(in) :: instance
	logical :: flag
	end function process_instance_is_complete_event
	<<Instances: procedures>>=
	module function process_instance_is_complete_event (instance) result (flag)
	class(process_instance_t), intent(in) :: instance
	logical :: flag
	flag = instance%evaluation_status >= STAT_EVENT_COMPLETE
	end function process_instance_is_complete_event

	@ %def process_instance_is_complete_event
	@ Select the term for the process instance that will provide the basic
	event record (used in [[evt_trivial_make_particle_set]]). It might be
	necessary to write out additional events corresponding to other terms
	(done in [[evt_nlo]]).
	<<Instances: process instance: TBP>>=
	procedure :: select_i_term => process_instance_select_i_term
	<<Instances: sub interfaces>>=
	module function process_instance_select_i_term (instance) result (i_term)
	integer :: i_term
	class(process_instance_t), intent(in) :: instance
	end function process_instance_select_i_term
	<<Instances: procedures>>=
	module function process_instance_select_i_term (instance) result (i_term)
	integer :: i_term
	class(process_instance_t), intent(in) :: instance
	integer :: i_mci
	i_mci = instance%i_mci
	i_term = instance%process%select_i_term (i_mci)
	end function process_instance_select_i_term

	@ %def process_instance_select_i_term
	@ Return pointer to the master beam interaction.
	<<Instances: process instance: TBP>>=
	procedure :: get_beam_int_ptr => process_instance_get_beam_int_ptr
	<<Instances: sub interfaces>>=
	module function process_instance_get_beam_int_ptr (instance) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	type(interaction_t), pointer :: ptr
	end function process_instance_get_beam_int_ptr
	<<Instances: procedures>>=
	module function process_instance_get_beam_int_ptr (instance) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	type(interaction_t), pointer :: ptr
	ptr => instance%sf_chain%get_beam_int_ptr ()
	end function process_instance_get_beam_int_ptr

	@ %def process_instance_get_beam_int_ptr
	@ Return pointers to the matrix and flows interactions, given a term index.
	<<Instances: process instance: TBP>>=
	procedure :: get_trace_int_ptr => process_instance_get_trace_int_ptr
	procedure :: get_matrix_int_ptr => process_instance_get_matrix_int_ptr
	procedure :: get_flows_int_ptr => process_instance_get_flows_int_ptr
	<<Instances: sub interfaces>>=
	module function process_instance_get_trace_int_ptr &
	(instance, i_term) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	integer, intent(in) :: i_term
	type(interaction_t), pointer :: ptr
	end function process_instance_get_trace_int_ptr
	module function process_instance_get_matrix_int_ptr &
	(instance, i_term) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	integer, intent(in) :: i_term
	type(interaction_t), pointer :: ptr
	end function process_instance_get_matrix_int_ptr
	module function process_instance_get_flows_int_ptr &
	(instance, i_term) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	integer, intent(in) :: i_term
	type(interaction_t), pointer :: ptr
	end function process_instance_get_flows_int_ptr
	<<Instances: procedures>>=
	module function process_instance_get_trace_int_ptr &
	(instance, i_term) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	integer, intent(in) :: i_term
	type(interaction_t), pointer :: ptr
	ptr => instance%term(i_term)%connected%get_trace_int_ptr ()
	end function process_instance_get_trace_int_ptr

	module function process_instance_get_matrix_int_ptr &
	(instance, i_term) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	integer, intent(in) :: i_term
	type(interaction_t), pointer :: ptr
	ptr => instance%term(i_term)%connected%get_matrix_int_ptr ()
	end function process_instance_get_matrix_int_ptr

	module function process_instance_get_flows_int_ptr &
	(instance, i_term) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	integer, intent(in) :: i_term
	type(interaction_t), pointer :: ptr
	ptr => instance%term(i_term)%connected%get_flows_int_ptr ()
	end function process_instance_get_flows_int_ptr

	@ %def process_instance_get_trace_int_ptr
	@ %def process_instance_get_matrix_int_ptr
	@ %def process_instance_get_flows_int_ptr
	@ Return the complete account of flavor combinations in the underlying
	interaction object, including beams, radiation, and hard interaction.
	<<Instances: process instance: TBP>>=
	procedure :: get_state_flv => process_instance_get_state_flv
	<<Instances: sub interfaces>>=
	module function process_instance_get_state_flv &
	(instance, i_term) result (state_flv)
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	type(state_flv_content_t) :: state_flv
	end function process_instance_get_state_flv
	<<Instances: procedures>>=
	module function process_instance_get_state_flv &
	(instance, i_term) result (state_flv)
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	type(state_flv_content_t) :: state_flv
	state_flv = instance%term(i_term)%connected%get_state_flv ()
	end function process_instance_get_state_flv

	@ %def process_instance_get_state_flv
	@ Return pointers to the parton states of a selected term.
	<<Instances: process instance: TBP>>=
	procedure :: get_isolated_state_ptr => &
	process_instance_get_isolated_state_ptr
	procedure :: get_connected_state_ptr => &
	process_instance_get_connected_state_ptr
	<<Instances: sub interfaces>>=
	module function process_instance_get_isolated_state_ptr &
	(instance, i_term) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	integer, intent(in) :: i_term
	type(isolated_state_t), pointer :: ptr
	end function process_instance_get_isolated_state_ptr
	module function process_instance_get_connected_state_ptr &
	(instance, i_term) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	integer, intent(in) :: i_term
	type(connected_state_t), pointer :: ptr
	end function process_instance_get_connected_state_ptr
	<<Instances: procedures>>=
	module function process_instance_get_isolated_state_ptr &
	(instance, i_term) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	integer, intent(in) :: i_term
	type(isolated_state_t), pointer :: ptr
	ptr => instance%term(i_term)%isolated
	end function process_instance_get_isolated_state_ptr

	module function process_instance_get_connected_state_ptr &
	(instance, i_term) result (ptr)
	class(process_instance_t), intent(in), target :: instance
	integer, intent(in) :: i_term
	type(connected_state_t), pointer :: ptr
	ptr => instance%term(i_term)%connected
	end function process_instance_get_connected_state_ptr

	@ %def process_instance_get_isolated_state_ptr
	@ %def process_instance_get_connected_state_ptr
	@ Return the indices of the beam particles and incoming partons within the
	currently active state matrix, respectively.
	<<Instances: process instance: TBP>>=
	procedure :: get_beam_index => process_instance_get_beam_index
	procedure :: get_in_index => process_instance_get_in_index
	<<Instances: sub interfaces>>=
	module subroutine process_instance_get_beam_index (instance, i_term, i_beam)
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	integer, dimension(:), intent(out) :: i_beam
	end subroutine process_instance_get_beam_index
	module subroutine process_instance_get_in_index (instance, i_term, i_in)
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	integer, dimension(:), intent(out) :: i_in
	end subroutine process_instance_get_in_index
	<<Instances: procedures>>=
	module subroutine process_instance_get_beam_index (instance, i_term, i_beam)
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	integer, dimension(:), intent(out) :: i_beam
	call instance%term(i_term)%connected%get_beam_index (i_beam)
	end subroutine process_instance_get_beam_index

	module subroutine process_instance_get_in_index (instance, i_term, i_in)
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	integer, dimension(:), intent(out) :: i_in
	call instance%term(i_term)%connected%get_in_index (i_in)
	end subroutine process_instance_get_in_index

	@ %def process_instance_get_beam_index
	@ %def process_instance_get_in_index
	@ Return squared matrix element and event weight, and event weight
	excess where applicable. [[n_dropped]] is a number that can be
	nonzero when a weighted event has been generated, dropping events with
	zero weight (failed cuts) on the fly.
	If [[i_term]] is provided for [[get_sqme]], we take the first matrix
	element as we also set the first matrix element with [[set_only_matrix_element]]
	when computing the real, the dglap or the virtual contribution.
	<<Instances: process instance: TBP>>=
	procedure :: get_sqme => process_instance_get_sqme
	procedure :: get_weight => process_instance_get_weight
	procedure :: get_excess => process_instance_get_excess
	procedure :: get_n_dropped => process_instance_get_n_dropped
	<<Instances: sub interfaces>>=
	module function process_instance_get_sqme (instance, i_term) result (sqme)
	real(default) :: sqme
	class(process_instance_t), intent(in) :: instance
	integer, intent(in), optional :: i_term
	end function process_instance_get_sqme
	module function process_instance_get_weight (instance) result (weight)
	real(default) :: weight
	class(process_instance_t), intent(in) :: instance
	end function process_instance_get_weight
	module function process_instance_get_excess (instance) result (excess)
	real(default) :: excess
	class(process_instance_t), intent(in) :: instance
	end function process_instance_get_excess
	module function process_instance_get_n_dropped (instance) result (n_dropped)
	integer :: n_dropped
	class(process_instance_t), intent(in) :: instance
	end function process_instance_get_n_dropped
	<<Instances: procedures>>=
	module function process_instance_get_sqme (instance, i_term) result (sqme)
	real(default) :: sqme
	class(process_instance_t), intent(in) :: instance
	integer, intent(in), optional :: i_term
	if (instance%evaluation_status >= STAT_EVALUATED_TRACE) then
	if (present (i_term)) then
	sqme = instance%term(i_term)%connected%trace%get_matrix_element (1)
	else
	sqme = instance%sqme
	end if
	else
	sqme = 0
	end if
	end function process_instance_get_sqme

	module function process_instance_get_weight (instance) result (weight)
	real(default) :: weight
	class(process_instance_t), intent(in) :: instance
	if (instance%evaluation_status >= STAT_EVENT_COMPLETE) then
	weight = instance%weight
	else
	weight = 0
	end if
	end function process_instance_get_weight

	module function process_instance_get_excess (instance) result (excess)
	real(default) :: excess
	class(process_instance_t), intent(in) :: instance
	if (instance%evaluation_status >= STAT_EVENT_COMPLETE) then
	excess = instance%excess
	else
	excess = 0
	end if
	end function process_instance_get_excess

	module function process_instance_get_n_dropped (instance) result (n_dropped)
	integer :: n_dropped
	class(process_instance_t), intent(in) :: instance
	if (instance%evaluation_status >= STAT_EVENT_COMPLETE) then
	n_dropped = instance%n_dropped
	else
	n_dropped = 0
	end if
	end function process_instance_get_n_dropped

	@ %def process_instance_get_sqme
	@ %def process_instance_get_weight
	@ %def process_instance_get_excess
	@ %def process_instance_get_n_dropped
	@ Return the currently selected MCI channel.
	<<Instances: process instance: TBP>>=
	procedure :: get_channel => process_instance_get_channel
	<<Instances: sub interfaces>>=
	module function process_instance_get_channel (instance) result (channel)
	integer :: channel
	class(process_instance_t), intent(in) :: instance
	end function process_instance_get_channel
	<<Instances: procedures>>=
	module function process_instance_get_channel (instance) result (channel)
	integer :: channel
	class(process_instance_t), intent(in) :: instance
	channel = instance%selected_channel
	end function process_instance_get_channel

	@ %def process_instance_get_channel
	@
	<<Instances: process instance: TBP>>=
	procedure :: set_fac_scale => process_instance_set_fac_scale
	<<Instances: sub interfaces>>=
	module subroutine process_instance_set_fac_scale (instance, fac_scale)
	class(process_instance_t), intent(inout) :: instance
	real(default), intent(in) :: fac_scale
	end subroutine process_instance_set_fac_scale
	<<Instances: procedures>>=
	module subroutine process_instance_set_fac_scale (instance, fac_scale)
	class(process_instance_t), intent(inout) :: instance
	real(default), intent(in) :: fac_scale
	integer :: i_term
	i_term = 1
	call instance%term(i_term)%set_fac_scale (fac_scale)
	end subroutine process_instance_set_fac_scale

	@ %def process_instance_set_fac_scale
	@ Return factorization scale and strong coupling. We have to select a
	term instance.
	<<Instances: process instance: TBP>>=
	procedure :: get_fac_scale => process_instance_get_fac_scale
	procedure :: get_alpha_s => process_instance_get_alpha_s
	<<Instances: sub interfaces>>=
	module function process_instance_get_fac_scale &
	(instance, i_term) result (fac_scale)
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	real(default) :: fac_scale
	end function process_instance_get_fac_scale
	module function process_instance_get_alpha_s &
	(instance, i_term) result (alpha_s)
	real(default) :: alpha_s
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	end function process_instance_get_alpha_s
	<<Instances: procedures>>=
	module function process_instance_get_fac_scale &
	(instance, i_term) result (fac_scale)
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	real(default) :: fac_scale
	fac_scale = instance%term(i_term)%get_fac_scale ()
	end function process_instance_get_fac_scale

	module function process_instance_get_alpha_s &
	(instance, i_term) result (alpha_s)
	real(default) :: alpha_s
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	class(prc_core_t), pointer :: core => null ()
	core => instance%process%get_core_term (i_term)
	alpha_s = instance%term(i_term)%get_alpha_s (core)
	core => null ()
	end function process_instance_get_alpha_s

	@ %def process_instance_get_fac_scale
	@ %def process_instance_get_alpha_s
	@
	<<Instances: process instance: TBP>>=
	procedure :: get_qcd => process_instance_get_qcd
	<<Instances: sub interfaces>>=
	module function process_instance_get_qcd (process_instance) result (qcd)
	type(qcd_t) :: qcd
	class(process_instance_t), intent(in) :: process_instance
	end function process_instance_get_qcd
	<<Instances: procedures>>=
	module function process_instance_get_qcd (process_instance) result (qcd)
	type(qcd_t) :: qcd
	class(process_instance_t), intent(in) :: process_instance
	qcd = process_instance%process%get_qcd ()
	end function process_instance_get_qcd

	@ %def process_instance_get_qcd
	@ Counter.
	<<Instances: process instance: TBP>>=
	procedure :: reset_counter => process_instance_reset_counter
	procedure :: record_call => process_instance_record_call
	procedure :: get_counter => process_instance_get_counter
	<<Instances: sub interfaces>>=
	module subroutine process_instance_reset_counter (process_instance)
	class(process_instance_t), intent(inout) :: process_instance
	end subroutine process_instance_reset_counter
	module subroutine process_instance_record_call (process_instance)
	class(process_instance_t), intent(inout) :: process_instance
	end subroutine process_instance_record_call
	pure module function process_instance_get_counter &
	(process_instance) result (counter)
	class(process_instance_t), intent(in) :: process_instance
	type(process_counter_t) :: counter
	end function process_instance_get_counter
	<<Instances: procedures>>=
	module subroutine process_instance_reset_counter (process_instance)
	class(process_instance_t), intent(inout) :: process_instance
	call process_instance%mci_work(process_instance%i_mci)%reset_counter ()
	end subroutine process_instance_reset_counter

	module subroutine process_instance_record_call (process_instance)
	class(process_instance_t), intent(inout) :: process_instance
	call process_instance%mci_work(process_instance%i_mci)%record_call &
	(process_instance%evaluation_status)
	end subroutine process_instance_record_call

	pure module function process_instance_get_counter &
	(process_instance) result (counter)
	class(process_instance_t), intent(in) :: process_instance
	type(process_counter_t) :: counter
	counter = process_instance%mci_work(process_instance%i_mci)%get_counter ()
	end function process_instance_get_counter

	@ %def process_instance_reset_counter
	@ %def process_instance_record_call
	@ %def process_instance_get_counter
	@ Sum up the total number of calls for all MCI records.
	<<Instances: process instance: TBP>>=
	procedure :: get_actual_calls_total => process_instance_get_actual_calls_total
	<<Instances: sub interfaces>>=
	pure module function process_instance_get_actual_calls_total &
	(process_instance) result (n)
	class(process_instance_t), intent(in) :: process_instance
	integer :: n
	end function process_instance_get_actual_calls_total
	<<Instances: procedures>>=
	pure module function process_instance_get_actual_calls_total &
	(process_instance) result (n)
	class(process_instance_t), intent(in) :: process_instance
	integer :: n
	integer :: i
	type(process_counter_t) :: counter
	n = 0
	do i = 1, size (process_instance%mci_work)
	counter = process_instance%mci_work(i)%get_counter ()
	n = n + counter%total
	end do
	end function process_instance_get_actual_calls_total

	@ %def process_instance_get_actual_calls_total
	@
	<<Instances: process instance: TBP>>=
	procedure :: reset_matrix_elements => process_instance_reset_matrix_elements
	<<Instances: sub interfaces>>=
	module subroutine process_instance_reset_matrix_elements (instance)
	class(process_instance_t), intent(inout) :: instance
	end subroutine process_instance_reset_matrix_elements
	<<Instances: procedures>>=
	module subroutine process_instance_reset_matrix_elements (instance)
	class(process_instance_t), intent(inout) :: instance
	integer :: i_term
	do i_term = 1, size (instance%term)
	call instance%term(i_term)%connected%trace%set_matrix_element &
	(cmplx (0, 0, default))
	call instance%term(i_term)%connected%matrix%set_matrix_element &
	(cmplx (0, 0, default))
	end do
	end subroutine process_instance_reset_matrix_elements

	@ %def process_instance_reset_matrix_elements
	@
	<<Instances: process instance: TBP>>=
	procedure :: get_test_phase_space_point &
	=> process_instance_get_test_phase_space_point
	<<Instances: sub interfaces>>=
	module subroutine process_instance_get_test_phase_space_point (instance, &
	i_component, i_core, p)
	type(vector4_t), dimension(:), allocatable, intent(out) :: p
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_component, i_core
	end subroutine process_instance_get_test_phase_space_point
	<<Instances: procedures>>=
	module subroutine process_instance_get_test_phase_space_point (instance, &
	i_component, i_core, p)
	type(vector4_t), dimension(:), allocatable, intent(out) :: p
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_component, i_core
	real(default), dimension(:), allocatable :: x
	logical :: success
	integer :: i_term
	instance%i_mci = i_component
	i_term = instance%process%get_i_term (i_core)
	associate (term => instance%term(i_term), kin => instance%kin(i_term))
	allocate (x (instance%mci_work(i_component)%config%n_par))
	x = 0.5_default
	call instance%set_mcpar (x, .true.)
	call instance%select_channel (1)
	call term%compute_seed_kinematics &
	(kin, instance%mci_work(i_component), 1, success)
	call kin%evaluate_radiation_kinematics &
	(instance%mci_work(instance%i_mci)%get_x_process ())
	call term%compute_hard_kinematics (kin, success = success)
	allocate (p (size (term%p_hard)))
	p = term%int_hard%get_momenta ()
	end associate
	end subroutine process_instance_get_test_phase_space_point

	@ %def process_instance_get_test_phase_space_point
	@
	<<Instances: process instance: TBP>>=
	procedure :: get_p_hard => process_instance_get_p_hard
	<<Instances: sub interfaces>>=
	pure module function process_instance_get_p_hard &
	(process_instance, i_term) result (p_hard)
	type(vector4_t), dimension(:), allocatable :: p_hard
	class(process_instance_t), intent(in) :: process_instance
	integer, intent(in) :: i_term
	end function process_instance_get_p_hard
	<<Instances: procedures>>=
	pure module function process_instance_get_p_hard &
	(process_instance, i_term) result (p_hard)
	type(vector4_t), dimension(:), allocatable :: p_hard
	class(process_instance_t), intent(in) :: process_instance
	integer, intent(in) :: i_term
	allocate (p_hard (size (process_instance%term(i_term)%get_p_hard ())))
	p_hard = process_instance%term(i_term)%get_p_hard ()
	end function process_instance_get_p_hard

	@ %def process_instance_get_p_hard
	@
	<<Instances: process instance: TBP>>=
	procedure :: get_first_active_i_term => &
	process_instance_get_first_active_i_term
	<<Instances: sub interfaces>>=
	module function process_instance_get_first_active_i_term &
	(instance) result (i_term)
	integer :: i_term
	class(process_instance_t), intent(in) :: instance
	end function process_instance_get_first_active_i_term
	<<Instances: procedures>>=
	module function process_instance_get_first_active_i_term &
	(instance) result (i_term)
	integer :: i_term
	class(process_instance_t), intent(in) :: instance
	integer :: i
	i_term = 0
	do i = 1, size (instance%term)
	if (instance%term(i)%active) then
	i_term = i
	exit
	end if
	end do
	end function process_instance_get_first_active_i_term

	@ %def process_instance_get_first_active_i_term
	@
	<<Instances: process instance: TBP>>=
	procedure :: get_real_of_mci => process_instance_get_real_of_mci
	<<Instances: sub interfaces>>=
	module function process_instance_get_real_of_mci (instance) result (i_real)
	integer :: i_real
	class(process_instance_t), intent(in) :: instance
	end function process_instance_get_real_of_mci
	<<Instances: procedures>>=
	module function process_instance_get_real_of_mci (instance) result (i_real)
	integer :: i_real
	class(process_instance_t), intent(in) :: instance
	select type (pcm_work => instance%pcm_work)
	type is (pcm_nlo_workspace_t)
	i_real = pcm_work%i_mci_to_real_component (instance%i_mci)
	end select
	end function process_instance_get_real_of_mci

	@ %def process_instance_get_real_of_mci
	@
	<<Instances: process instance: TBP>>=
	procedure :: get_connected_states => process_instance_get_connected_states
	<<Instances: sub interfaces>>=
	module function process_instance_get_connected_states &
	(instance, i_component) result (connected)
	type(connected_state_t), dimension(:), allocatable :: connected
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_component
	end function process_instance_get_connected_states
	<<Instances: procedures>>=
	module function process_instance_get_connected_states &
	(instance, i_component) result (connected)
	type(connected_state_t), dimension(:), allocatable :: connected
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_component
	connected = instance%process%get_connected_states (i_component, &
	instance%term(:)%connected)
	end function process_instance_get_connected_states

	@ %def process_instance_get_connected_states
	@ Get the hadronic center-of-mass energy
	<<Instances: process instance: TBP>>=
	procedure :: get_sqrts => process_instance_get_sqrts
	<<Instances: sub interfaces>>=
	module function process_instance_get_sqrts (instance) result (sqrts)
	class(process_instance_t), intent(in) :: instance
	real(default) :: sqrts
	end function process_instance_get_sqrts
	<<Instances: procedures>>=
	module function process_instance_get_sqrts (instance) result (sqrts)
	class(process_instance_t), intent(in) :: instance
	real(default) :: sqrts
	sqrts = instance%process%get_sqrts ()
	end function process_instance_get_sqrts

	@ %def process_instance_get_sqrts
	@ Get the polarizations
	<<Instances: process instance: TBP>>=
	procedure :: get_polarization => process_instance_get_polarization
	<<Instances: sub interfaces>>=
	module function process_instance_get_polarization (instance) result (pol)
	class(process_instance_t), intent(in) :: instance
	real(default), dimension(:), allocatable :: pol
	end function process_instance_get_polarization
	<<Instances: procedures>>=
	module function process_instance_get_polarization (instance) result (pol)
	class(process_instance_t), intent(in) :: instance
	real(default), dimension(:), allocatable :: pol
	pol = instance%process%get_polarization ()
	end function process_instance_get_polarization

	@ %def process_instance_get_polarization
	@ Get the beam spectrum
	<<Instances: process instance: TBP>>=
	procedure :: get_beam_file => process_instance_get_beam_file
	<<Instances: sub interfaces>>=
	module function process_instance_get_beam_file (instance) result (file)
	class(process_instance_t), intent(in) :: instance
	type(string_t) :: file
	end function process_instance_get_beam_file
	<<Instances: procedures>>=
	module function process_instance_get_beam_file (instance) result (file)
	class(process_instance_t), intent(in) :: instance
	type(string_t) :: file
	file = instance%process%get_beam_file ()
	end function process_instance_get_beam_file

	@ %def process_instance_get_beam_file
	@ Get the process name
	<<Instances: process instance: TBP>>=
	procedure :: get_process_name => process_instance_get_process_name
	<<Instances: sub interfaces>>=
	module function process_instance_get_process_name (instance) result (name)
	class(process_instance_t), intent(in) :: instance
	type(string_t) :: name
	end function process_instance_get_process_name
	<<Instances: procedures>>=
	module function process_instance_get_process_name (instance) result (name)
	class(process_instance_t), intent(in) :: instance
	type(string_t) :: name
	name = instance%process%get_id ()
	end function process_instance_get_process_name

	@ %def process_instance_get_process_name
	@
	\subsubsection{Particle sets}
	Here we provide two procedures that convert the process instance
	from/to a particle set. The conversion applies to the trace evaluator
	which has no quantum-number information, thus it involves only the
	momenta and the parent-child relations. We keep virtual particles.

	If [[n_incoming]] is provided, the status code of the first
	[[n_incoming]] particles will be reset to incoming. Otherwise, they
	would be classified as virtual.

	Nevertheless, it is possible to reconstruct the complete structure
	from a particle set. The reconstruction implies a re-evaluation of
	the structure function and matrix-element codes.

	The [[i_term]] index is needed for both input and output, to select
	among different active trace evaluators.

	In both cases, the [[instance]] object must be properly initialized.

	NB: The [[recover_beams]] option should be used only when the particle
	set originates from an external event file, and the user has asked for
	it. It should be switched off when reading from raw event file.
	<<Instances: process instance: TBP>>=
	procedure :: get_trace => process_instance_get_trace
	procedure :: set_trace => process_instance_set_trace
	<<Instances: sub interfaces>>=
	module subroutine process_instance_get_trace &
	(instance, pset, i_term, n_incoming)
	class(process_instance_t), intent(in), target :: instance
	type(particle_set_t), intent(out) :: pset
	integer, intent(in) :: i_term
	integer, intent(in), optional :: n_incoming
	end subroutine process_instance_get_trace
	module subroutine process_instance_set_trace &
	(instance, pset, i_term, recover_beams, check_match, success)
	class(process_instance_t), intent(inout), target :: instance
	type(particle_set_t), intent(in) :: pset
	integer, intent(in) :: i_term
	logical, intent(in), optional :: recover_beams, check_match
	logical, intent(out), optional :: success
	end subroutine process_instance_set_trace
	<<Instances: procedures>>=
	module subroutine process_instance_get_trace &
	(instance, pset, i_term, n_incoming)
	class(process_instance_t), intent(in), target :: instance
	type(particle_set_t), intent(out) :: pset
	integer, intent(in) :: i_term
	integer, intent(in), optional :: n_incoming
	type(interaction_t), pointer :: int
	logical :: ok
	int => instance%get_trace_int_ptr (i_term)
	call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
	[0._default, 0._default], .false., .true., n_incoming)
	end subroutine process_instance_get_trace

	module subroutine process_instance_set_trace &
	(instance, pset, i_term, recover_beams, check_match, success)
	class(process_instance_t), intent(inout), target :: instance
	type(particle_set_t), intent(in) :: pset
	integer, intent(in) :: i_term
	logical, intent(in), optional :: recover_beams, check_match
	logical, intent(out), optional :: success
	type(interaction_t), pointer :: int
	integer :: n_in
	int => instance%get_trace_int_ptr (i_term)
	n_in = instance%process%get_n_in ()
	call pset%fill_interaction (int, n_in, &
	recover_beams = recover_beams, &
	check_match = check_match, &
	state_flv = instance%get_state_flv (i_term), &
	success = success)
	end subroutine process_instance_set_trace

	@ %def process_instance_get_trace
	@ %def process_instance_set_trace
	@ This procedure allows us to override any QCD setting of the WHIZARD process
	and directly set the coupling value that comes together with a particle set.
	<<Instances: process instance: TBP>>=
	procedure :: set_alpha_qcd_forced => process_instance_set_alpha_qcd_forced
	<<Instances: sub interfaces>>=
	module subroutine process_instance_set_alpha_qcd_forced &
	(instance, i_term, alpha_qcd)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	real(default), intent(in) :: alpha_qcd
	end subroutine process_instance_set_alpha_qcd_forced
	<<Instances: procedures>>=
	module subroutine process_instance_set_alpha_qcd_forced &
	(instance, i_term, alpha_qcd)
	class(process_instance_t), intent(inout) :: instance
	integer, intent(in) :: i_term
	real(default), intent(in) :: alpha_qcd
	call instance%term(i_term)%set_alpha_qcd_forced (alpha_qcd)
	end subroutine process_instance_set_alpha_qcd_forced

	@ %def process_instance_set_alpha_qcd_forced
	@
	<<Instances: process instance: TBP>>=
	procedure :: has_nlo_component => process_instance_has_nlo_component
	<<Instances: sub interfaces>>=
	module function process_instance_has_nlo_component (instance) result (nlo)
	class(process_instance_t), intent(in) :: instance
	logical :: nlo
	end function process_instance_has_nlo_component
	<<Instances: procedures>>=
	module function process_instance_has_nlo_component (instance) result (nlo)
	class(process_instance_t), intent(in) :: instance
	logical :: nlo
	nlo = instance%process%is_nlo_calculation ()
	end function process_instance_has_nlo_component

	@ %def process_instance_has_nlo_component
	@
	<<Instances: process instance: TBP>>=
	procedure :: keep_failed_events => process_instance_keep_failed_events
	<<Instances: sub interfaces>>=
	module function process_instance_keep_failed_events (instance) result (keep)
	logical :: keep
	class(process_instance_t), intent(in) :: instance
	end function process_instance_keep_failed_events
	<<Instances: procedures>>=
	module function process_instance_keep_failed_events (instance) result (keep)
	logical :: keep
	class(process_instance_t), intent(in) :: instance
	keep = instance%mci_work(instance%i_mci)%keep_failed_events
	end function process_instance_keep_failed_events

	@ %def process_instance_keep_failed_events
	@
	<<Instances: process instance: TBP>>=
	procedure :: get_term_indices => process_instance_get_term_indices
	<<Instances: sub interfaces>>=
	module function process_instance_get_term_indices &
	(instance, nlo_type) result (i_term)
	integer, dimension(:), allocatable :: i_term
	class(process_instance_t), intent(in) :: instance
	integer :: nlo_type
	end function process_instance_get_term_indices
	<<Instances: procedures>>=
	module function process_instance_get_term_indices &
	(instance, nlo_type) result (i_term)
	integer, dimension(:), allocatable :: i_term
	class(process_instance_t), intent(in) :: instance
	integer :: nlo_type
	allocate (i_term (count (instance%term%nlo_type == nlo_type)))
	i_term = pack (instance%term%get_i_term_global (), &
	instance%term%nlo_type == nlo_type)
	end function process_instance_get_term_indices

	@ %def process_instance_get_term_indices
	@
	<<Instances: process instance: TBP>>=
	procedure :: get_boost_to_lab => process_instance_get_boost_to_lab
	<<Instances: sub interfaces>>=
	module function process_instance_get_boost_to_lab &
	(instance, i_term) result (lt)
	type(lorentz_transformation_t) :: lt
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	end function process_instance_get_boost_to_lab
	<<Instances: procedures>>=
	module function process_instance_get_boost_to_lab &
	(instance, i_term) result (lt)
	type(lorentz_transformation_t) :: lt
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	lt = instance%kin(i_term)%get_boost_to_lab ()
	end function process_instance_get_boost_to_lab

	@ %def process_instance_get_boost_to_lab
	@
	<<Instances: process instance: TBP>>=
	procedure :: get_boost_to_cms => process_instance_get_boost_to_cms
	<<Instances: sub interfaces>>=
	module function process_instance_get_boost_to_cms &
	(instance, i_term) result (lt)
	type(lorentz_transformation_t) :: lt
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	end function process_instance_get_boost_to_cms
	<<Instances: procedures>>=
	module function process_instance_get_boost_to_cms &
	(instance, i_term) result (lt)
	type(lorentz_transformation_t) :: lt
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	lt = instance%kin(i_term)%get_boost_to_cms ()
	end function process_instance_get_boost_to_cms

	@ %def process_instance_get_boost_to_cms
	@
	<<Instances: process instance: TBP>>=
	procedure :: lab_is_cm => process_instance_lab_is_cm
	<<Instances: sub interfaces>>=
	module function process_instance_lab_is_cm &
	(instance, i_term) result (lab_is_cm)
	logical :: lab_is_cm
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	end function process_instance_lab_is_cm
	<<Instances: procedures>>=
	module function process_instance_lab_is_cm &
	(instance, i_term) result (lab_is_cm)
	logical :: lab_is_cm
	class(process_instance_t), intent(in) :: instance
	integer, intent(in) :: i_term
	lab_is_cm = instance%kin(i_term)%phs%lab_is_cm ()
	end function process_instance_lab_is_cm

	@ %def process_instance_lab_is_cm
	@
	The [[pacify]] subroutine has the purpose of setting numbers to zero
	which are (by comparing with a [[tolerance]] parameter) considered
	equivalent with zero. We do this in some unit tests. Here, we a
	apply this to the phase space subobject of the process instance.
	<<Instances: public>>=
	public :: pacify
	<<Instances: interfaces>>=
	interface pacify
	module procedure pacify_process_instance
	end interface pacify

	<<Instances: sub interfaces>>=
	module subroutine pacify_process_instance (instance)
	type(process_instance_t), intent(inout) :: instance
	end subroutine pacify_process_instance
	<<Instances: procedures>>=
	module subroutine pacify_process_instance (instance)
	type(process_instance_t), intent(inout) :: instance
	integer :: i
	do i = 1, size (instance%kin)
	call pacify (instance%kin(i)%phs)
	end do
	end subroutine pacify_process_instance

	@ %def pacify
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[processes_ut.f90]]>>=
	<<File header>>

	module processes_ut
	use unit_tests
	use processes_uti

	<<Standard module head>>

	<<Processes: public test>>

	<<Processes: public test auxiliary>>

	contains

	<<Processes: test driver>>

	end module processes_ut
	@ %def processes_ut
	@
	<<[[processes_uti.f90]]>>=
	<<File header>>

	module processes_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use constants, only: TWOPI4
	use physics_defs, only: CONV
	use os_interface
	use sm_qcd
	use lorentz
	use pdg_arrays
	use model_data
	use models
	use var_base, only: vars_t
	use variables, only: var_list_t
	use model_testbed, only: prepare_model
	use particle_specifiers, only: new_prt_spec
	use flavors
	use interactions, only: reset_interaction_counter
	use particles
	use rng_base
	use mci_base
	use mci_none, only: mci_none_t
	use mci_midpoint
	use sf_mappings
	use sf_base
	use phs_base
	use phs_single
	use phs_forests, only: syntax_phs_forest_init, syntax_phs_forest_final
	use phs_wood, only: phs_wood_config_t
	use resonances, only: resonance_history_set_t
	use process_constants
	use prc_core_def, only: prc_core_def_t
	use prc_core
	use prc_test, only: prc_test_create_library
	use prc_template_me, only: template_me_def_t
	use process_libraries
	use prc_test_core
	use pdf, only: pdf_data_t

	use process_counter
	use process_config, only: process_term_t
	use process, only: process_t
	use instances, only: process_instance_t, process_instance_hook_t

	use rng_base_ut, only: rng_test_factory_t
	use sf_base_ut, only: sf_test_data_t
	use mci_base_ut, only: mci_test_t
	use phs_base_ut, only: phs_test_config_t

	<<Standard module head>>

	<<Processes: public test auxiliary>>

	<<Processes: test declarations>>

	<<Processes: test types>>

	contains

	<<Processes: tests>>

	<<Processes: test auxiliary>>

	end module processes_uti

	@ %def processes_uti
	@ API: driver for the unit tests below.
	<<Processes: public test>>=
	public :: processes_test
	<<Processes: test driver>>=
	subroutine processes_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Processes: execute tests>>
	end subroutine processes_test

	@ %def processes_test
	\subsubsection{Write an empty process object}
	The most trivial test is to write an uninitialized process object.
	<<Processes: execute tests>>=
	call test (processes_1, "processes_1", &
	"write an empty process object", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_1
	<<Processes: tests>>=
	subroutine processes_1 (u)
	integer, intent(in) :: u
	type(process_t) :: process

	write (u, "(A)") "* Test output: processes_1"
	write (u, "(A)") "* Purpose: display an empty process object"
	write (u, "(A)")

	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_1"

	end subroutine processes_1

	@ %def processes_1
	@
	\subsubsection{Initialize a process object}
	Initialize a process and display it.
	<<Processes: execute tests>>=
	call test (processes_2, "processes_2", &
	"initialize a simple process object", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_2
	<<Processes: tests>>=
	subroutine processes_2 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable :: process
	class(mci_t), allocatable :: mci_template
	class(phs_config_t), allocatable :: phs_config_template

	write (u, "(A)") "* Test output: processes_2"
	write (u, "(A)") "* Purpose: initialize a simple process object"
	write (u, "(A)")

	write (u, "(A)") "* Build and load a test library with one process"
	write (u, "(A)")

	libname = "processes2"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)

	write (u, "(A)") "* Initialize a process object"
	write (u, "(A)")

	call model%init_test ()

	allocate (process)
	call process%init (procname, lib, os_data, model)
	call process%set_run_id (var_str ("run_2"))
	call process%setup_test_cores ()

	allocate (phs_test_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	call process%setup_mci (dispatch_mci_empty)

	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_2"

	end subroutine processes_2

	@ %def processes_2
	@ Trivial for testing: do not allocate the MCI record.
	<<Processes: test auxiliary>>=
	subroutine dispatch_mci_empty (mci, var_list, process_id, is_nlo)
	class(mci_t), allocatable, intent(out) :: mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	logical, intent(in), optional :: is_nlo
	end subroutine dispatch_mci_empty

	@ %def dispatch_mci_empty
	@
	\subsubsection{Compute a trivial matrix element}
	Initialize a process, retrieve some information and compute a matrix
	element.

	We use the same trivial process as for the previous test. All
	momentum and state dependence is trivial, so we just test basic
	functionality.
	<<Processes: execute tests>>=
	call test (processes_3, "processes_3", &
	"retrieve a trivial matrix element", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_3
	<<Processes: tests>>=
	subroutine processes_3 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable :: process
	class(phs_config_t), allocatable :: phs_config_template
	type(process_constants_t) :: data
	type(vector4_t), dimension(:), allocatable :: p

	write (u, "(A)") "* Test output: processes_3"
	write (u, "(A)") "* Purpose: create a process &
	&and compute a matrix element"
	write (u, "(A)")

	write (u, "(A)") "* Build and load a test library with one process"
	write (u, "(A)")

	libname = "processes3"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)

	call model%init_test ()

	allocate (process)
	call process%init (procname, lib, os_data, model)
	call process%setup_test_cores ()

	allocate (phs_test_config_t :: phs_config_template)
	call process%init_components (phs_config_template)
	call process%setup_mci (dispatch_mci_test3)

	write (u, "(A)") "* Return the number of process components"
	write (u, "(A)")

	write (u, "(A,I0)") "n_components = ", process%get_n_components ()

	write (u, "(A)")
	write (u, "(A)") "* Return the number of flavor states"
	write (u, "(A)")

	data = process%get_constants (1)

	write (u, "(A,I0)") "n_flv(1) = ", data%n_flv

	write (u, "(A)")
	write (u, "(A)") "* Return the first flavor state"
	write (u, "(A)")

	write (u, "(A,4(1x,I0))") "flv_state(1) =", data%flv_state (:,1)

	write (u, "(A)")
	write (u, "(A)") "* Set up kinematics &
	&[arbitrary, the matrix element is constant]"

	allocate (p (4))

	write (u, "(A)")
	write (u, "(A)") "* Retrieve the matrix element"
	write (u, "(A)")


	write (u, "(A,F5.3,' + ',F5.3,' I')") "me (1, p, 1, 1, 1) = ", &
	process%compute_amplitude (1, 1, 1, p, 1, 1, 1)


	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_3"

	end subroutine processes_3

	@ %def processes_3
	@ MCI record with some contents.
	<<Processes: test auxiliary>>=
	subroutine dispatch_mci_test3 (mci, var_list, process_id, is_nlo)
	class(mci_t), allocatable, intent(out) :: mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	logical, intent(in), optional :: is_nlo
	allocate (mci_test_t :: mci)
	select type (mci)
	type is (mci_test_t)
	call mci%set_dimensions (2, 2)
	call mci%set_divisions (100)
	end select
	end subroutine dispatch_mci_test3

	@ %def dispatch_mci_test3
	@
	\subsubsection{Generate a process instance}
	Initialize a process and process instance, choose a sampling point and
	fill the process instance.

	We use the same trivial process as for the previous test. All
	momentum and state dependence is trivial, so we just test basic
	functionality.
	<<Processes: execute tests>>=
	call test (processes_4, "processes_4", &
	"create and fill a process instance (partonic event)", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_4
	<<Processes: tests>>=
	subroutine processes_4 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable, target :: process
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_instance_t), allocatable, target :: process_instance
	type(particle_set_t) :: pset

	write (u, "(A)") "* Test output: processes_4"
	write (u, "(A)") "* Purpose: create a process &
	&and fill a process instance"
	write (u, "(A)")

	write (u, "(A)") "* Build and initialize a test process"
	write (u, "(A)")

	libname = "processes4"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)

	call reset_interaction_counter ()

	call model%init_test ()

	allocate (process)
	call process%init (procname, lib, os_data, model)

	call process%setup_test_cores ()
	allocate (phs_test_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Prepare a trivial beam setup"
	write (u, "(A)")

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()
	call process%setup_mci (dispatch_mci_empty)

	write (u, "(A)") "* Complete process initialization"
	write (u, "(A)")

	call process%setup_terms ()
	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance"
	write (u, "(A)")

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Inject a set of random numbers"
	write (u, "(A)")

	call process_instance%choose_mci (1)
	call process_instance%set_mcpar ([0._default, 0._default])
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Set up hard kinematics"
	write (u, "(A)")

	call process_instance%select_channel (1)
	call process_instance%compute_seed_kinematics ()
	call process_instance%compute_hard_kinematics ()
	call process_instance%compute_eff_kinematics ()
	call process_instance%evaluate_expressions ()
	call process_instance%compute_other_channels ()

	write (u, "(A)") "* Evaluate matrix element and square"
	write (u, "(A)")

	call process_instance%evaluate_trace ()
	call process_instance%write (u)

	call process_instance%get_trace (pset, 1)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Particle content:"
	write (u, "(A)")

	call write_separator (u)
	call pset%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover process instance"
	write (u, "(A)")

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1, check_match = .false.)

	call process_instance%activate ()
	process_instance%evaluation_status = STAT_EFF_KINEMATICS
	call process_instance%recover_hard_kinematics (i_term = 1)
	call process_instance%recover_seed_kinematics (i_term = 1)
	call process_instance%select_channel (1)
	call process_instance%recover_mcpar (i_term = 1)

	call process_instance%compute_seed_kinematics (skip_term = 1)
	call process_instance%compute_hard_kinematics (skip_term = 1)
	call process_instance%compute_eff_kinematics (skip_term = 1)

	call process_instance%evaluate_expressions ()
	call process_instance%compute_other_channels (skip_term = 1)
	call process_instance%evaluate_trace ()
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call pset%final ()
	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_4"

	end subroutine processes_4

	@ %def processes_4
	@
	\subsubsection{Structure function configuration}
	Configure structure functions (multi-channel) in a process object.
	<<Processes: execute tests>>=
	call test (processes_7, "processes_7", &
	"process configuration with structure functions", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_7
	<<Processes: tests>>=
	subroutine processes_7 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable, target :: process
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	type(sf_config_t), dimension(:), allocatable :: sf_config
	type(sf_channel_t), dimension(2) :: sf_channel

	write (u, "(A)") "* Test output: processes_7"
	write (u, "(A)") "* Purpose: initialize a process with &
	&structure functions"
	write (u, "(A)")

	write (u, "(A)") "* Build and initialize a process object"
	write (u, "(A)")

	libname = "processes7"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)

	call model%init_test ()

	allocate (process)
	call process%init (procname, lib, os_data, model)

	call process%setup_test_cores ()
	allocate (phs_test_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Set beam, structure functions, and mappings"
	write (u, "(A)")

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()

	pdg_in = 25
	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (process%get_model_ptr (), pdg_in)
	end select

	allocate (sf_config (2))
	call sf_config(1)%init ([1], data)
	call sf_config(2)%init ([2], data)
	call process%init_sf_chain (sf_config)
	deallocate (sf_config)

	call process%test_allocate_sf_channels (3)

	call sf_channel(1)%init (2)
	call sf_channel(1)%activate_mapping ([1,2])
	call process%set_sf_channel (2, sf_channel(1))

	call sf_channel(2)%init (2)
	call sf_channel(2)%set_s_mapping ([1,2])
	call process%set_sf_channel (3, sf_channel(2))

	call process%setup_mci (dispatch_mci_empty)

	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_7"

	end subroutine processes_7

	@ %def processes_7
	@
	\subsubsection{Evaluating a process with structure function}
	Configure structure functions (single-channel) in a process object,
	create an instance, compute kinematics and evaluate.

	Note the order of operations when setting up structure functions and
	phase space. The beams are first, they determine the [[sqrts]] value.
	We can also set up the chain of structure functions. We then
	configure the phase space. From this, we can obtain information about
	special configurations (resonances, etc.), which we need for
	allocating the possible structure-function channels (parameterizations
	and mappings). Finally, we match phase-space channels onto
	structure-function channels.

	In the current example, this matching is trivial; we only have one
	structure-function channel.
	<<Processes: execute tests>>=
	call test (processes_8, "processes_8", &
	"process evaluation with structure functions", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_8
	<<Processes: tests>>=
	subroutine processes_8 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable, target :: process
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_instance_t), allocatable, target :: process_instance
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	type(sf_config_t), dimension(:), allocatable :: sf_config
	type(sf_channel_t) :: sf_channel
	type(particle_set_t) :: pset

	write (u, "(A)") "* Test output: processes_8"
	write (u, "(A)") "* Purpose: evaluate a process with &
	&structure functions"
	write (u, "(A)")

	write (u, "(A)") "* Build and initialize a process object"
	write (u, "(A)")

	libname = "processes8"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)

	call reset_interaction_counter ()

	call model%init_test ()

	allocate (process)
	call process%init (procname, lib, os_data, model)

	call process%setup_test_cores ()
	allocate (phs_test_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Set beam, structure functions, and mappings"
	write (u, "(A)")

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)

	pdg_in = 25
	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (process%get_model_ptr (), pdg_in)
	end select

	allocate (sf_config (2))
	call sf_config(1)%init ([1], data)
	call sf_config(2)%init ([2], data)
	call process%init_sf_chain (sf_config)
	deallocate (sf_config)

	call process%configure_phs ()

	call process%test_allocate_sf_channels (1)

	call sf_channel%init (2)
	call sf_channel%activate_mapping ([1,2])
	call process%set_sf_channel (1, sf_channel)

	write (u, "(A)") "* Complete process initialization"
	write (u, "(A)")

	call process%setup_mci (dispatch_mci_empty)
	call process%setup_terms ()

	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance"
	write (u, "(A)")

	allocate (process_instance)
	call process_instance%init (process)

	write (u, "(A)") "* Set up kinematics and evaluate"
	write (u, "(A)")

	call process_instance%choose_mci (1)
	call process_instance%evaluate_sqme (1, &
	[0.8_default, 0.8_default, 0.1_default, 0.2_default])
	call process_instance%write (u)

	call process_instance%get_trace (pset, 1)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Particle content:"
	write (u, "(A)")

	call write_separator (u)
	call pacify (pset)
	call pset%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover process instance"
	write (u, "(A)")

	call reset_interaction_counter (2)

	allocate (process_instance)
	call process_instance%init (process)

	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1, check_match = .false.)
	call process_instance%recover &
	(channel = 1, i_term = 1, update_sqme = .true., recover_phs = .true.)
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call pset%final ()

	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_8"

	end subroutine processes_8

	@ %def processes_8
	@
	\subsubsection{Multi-channel phase space and structure function}
	This is an extension of the previous example. This time, we have two
	distinct structure-function channels which are matched to the two
	distinct phase-space channels.
	<<Processes: execute tests>>=
	call test (processes_9, "processes_9", &
	"multichannel kinematics and structure functions", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_9
	<<Processes: tests>>=
	subroutine processes_9 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable, target :: process
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_instance_t), allocatable, target :: process_instance
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	type(sf_config_t), dimension(:), allocatable :: sf_config
	type(sf_channel_t) :: sf_channel
	real(default), dimension(4) :: x_saved
	type(particle_set_t) :: pset

	write (u, "(A)") "* Test output: processes_9"
	write (u, "(A)") "* Purpose: evaluate a process with &
	&structure functions"
	write (u, "(A)") "* in a multi-channel configuration"
	write (u, "(A)")

	write (u, "(A)") "* Build and initialize a process object"
	write (u, "(A)")

	libname = "processes9"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)

	call reset_interaction_counter ()

	call model%init_test ()

	allocate (process)
	call process%init (procname, lib, os_data, model)

	call process%setup_test_cores ()
	allocate (phs_test_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Set beam, structure functions, and mappings"
	write (u, "(A)")

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)

	pdg_in = 25
	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (process%get_model_ptr (), pdg_in)
	end select

	allocate (sf_config (2))
	call sf_config(1)%init ([1], data)
	call sf_config(2)%init ([2], data)
	call process%init_sf_chain (sf_config)
	deallocate (sf_config)

	call process%configure_phs ()

	call process%test_allocate_sf_channels (2)

	call sf_channel%init (2)
	call process%set_sf_channel (1, sf_channel)

	call sf_channel%init (2)
	call sf_channel%activate_mapping ([1,2])
	call process%set_sf_channel (2, sf_channel)

	call process%test_set_component_sf_channel ([1, 2])

	write (u, "(A)") "* Complete process initialization"
	write (u, "(A)")

	call process%setup_mci (dispatch_mci_empty)
	call process%setup_terms ()

	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance"
	write (u, "(A)")

	allocate (process_instance)
	call process_instance%init (process)

	write (u, "(A)") "* Set up kinematics in channel 1 and evaluate"
	write (u, "(A)")

	call process_instance%choose_mci (1)
	call process_instance%evaluate_sqme (1, &
	[0.8_default, 0.8_default, 0.1_default, 0.2_default])
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Extract MC input parameters"
	write (u, "(A)")

	write (u, "(A)") "Channel 1:"
	call process_instance%get_mcpar (1, x_saved)
	write (u, "(2x,9(1x,F7.5))") x_saved

	write (u, "(A)") "Channel 2:"
	call process_instance%get_mcpar (2, x_saved)
	write (u, "(2x,9(1x,F7.5))") x_saved

	write (u, "(A)")
	write (u, "(A)") "* Set up kinematics in channel 2 and evaluate"
	write (u, "(A)")

	call process_instance%evaluate_sqme (2, x_saved)
	call process_instance%write (u)

	call process_instance%get_trace (pset, 1)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Recover process instance for channel 2"
	write (u, "(A)")

	call reset_interaction_counter (2)

	allocate (process_instance)
	call process_instance%init (process)

	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1, check_match = .false.)
	call process_instance%recover &
	(channel = 2, i_term = 1, update_sqme = .true., recover_phs = .true.)
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call pset%final ()

	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_9"

	end subroutine processes_9

	@ %def processes_9
	@
	\subsubsection{Event generation}
	Activate the MC integrator for the process object and use it to
	generate a single event. Note that the test integrator does not
	require integration in preparation for generating events.
	<<Processes: execute tests>>=
	call test (processes_10, "processes_10", &
	"event generation", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_10
	<<Processes: tests>>=
	subroutine processes_10 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable, target :: process
	class(mci_t), pointer :: mci
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_instance_t), allocatable, target :: process_instance

	write (u, "(A)") "* Test output: processes_10"
	write (u, "(A)") "* Purpose: generate events for a process without &
	&structure functions"
	write (u, "(A)") "* in a multi-channel configuration"
	write (u, "(A)")

	write (u, "(A)") "* Build and initialize a process object"
	write (u, "(A)")

	libname = "processes10"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)

	call reset_interaction_counter ()

	call model%init_test ()

	allocate (process)
	call process%init (procname, lib, os_data, model)

	call process%setup_test_cores ()
	allocate (phs_test_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Prepare a trivial beam setup"
	write (u, "(A)")

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()

	call process%setup_mci (dispatch_mci_test10)

	write (u, "(A)") "* Complete process initialization"
	write (u, "(A)")

	call process%setup_terms ()
	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance"
	write (u, "(A)")

	allocate (process_instance)
	call process_instance%init (process)

	write (u, "(A)") "* Generate weighted event"
	write (u, "(A)")

	call process%test_get_mci_ptr (mci)
	select type (mci)
	type is (mci_test_t)
	! This ensures that the next 'random' numbers are 0.3, 0.5, 0.7
	call mci%rng%init (3)
	! Include the constant PHS factor in the stored maximum of the integrand
	call mci%set_max_factor (conv * twopi4 &
	/ (2 * sqrt (lambda (sqrts 2, 125._default2, 125._default**2))))
	end select

	call process_instance%generate_weighted_event (1)
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate unweighted event"
	write (u, "(A)")

	call process_instance%generate_unweighted_event (1)
	call process%test_get_mci_ptr (mci)
	select type (mci)
	type is (mci_test_t)
	write (u, "(A,I0)") " Success in try ", mci%tries
	write (u, "(A)")
	end select

	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_10"

	end subroutine processes_10

	@ %def processes_10
	@ MCI record with some contents.
	<<Processes: test auxiliary>>=
	subroutine dispatch_mci_test10 (mci, var_list, process_id, is_nlo)
	class(mci_t), allocatable, intent(out) :: mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	logical, intent(in), optional :: is_nlo
	allocate (mci_test_t :: mci)
	select type (mci)
	type is (mci_test_t); call mci%set_divisions (100)
	end select
	end subroutine dispatch_mci_test10

	@ %def dispatch_mci_test10
	@
	\subsubsection{Integration}
	Activate the MC integrator for the process object and use it to
	integrate over phase space.
	<<Processes: execute tests>>=
	call test (processes_11, "processes_11", &
	"integration", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_11
	<<Processes: tests>>=
	subroutine processes_11 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable, target :: process
	class(mci_t), allocatable :: mci_template
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_instance_t), allocatable, target :: process_instance

	write (u, "(A)") "* Test output: processes_11"
	write (u, "(A)") "* Purpose: integrate a process without &
	&structure functions"
	write (u, "(A)") "* in a multi-channel configuration"
	write (u, "(A)")

	write (u, "(A)") "* Build and initialize a process object"
	write (u, "(A)")

	libname = "processes11"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)

	call reset_interaction_counter ()

	call model%init_test ()

	allocate (process)
	call process%init (procname, lib, os_data, model)

	call process%setup_test_cores ()

	allocate (phs_test_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Prepare a trivial beam setup"
	write (u, "(A)")

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()

	call process%setup_mci (dispatch_mci_test10)

	write (u, "(A)") "* Complete process initialization"
	write (u, "(A)")

	call process%setup_terms ()
	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance"
	write (u, "(A)")

	allocate (process_instance)
	call process_instance%init (process)

	write (u, "(A)") "* Integrate with default test parameters"
	write (u, "(A)")

	call process_instance%integrate (1, n_it=1, n_calls=10000)
	call process%final_integration (1)

	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A,ES13.7)") " Integral divided by phs factor = ", &
	process%get_integral (1) &
	/ process_instance%kin(1)%phs_factor

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_11"

	end subroutine processes_11

	@ %def processes_11
	@
	\subsubsection{Complete events}
	For the purpose of simplifying further tests, we implement a
	convenience routine that initializes a process and prepares a single
	event. This is a wrapup of the test [[processes_10]].

	The procedure is re-exported by the [[processes_ut]] module.
	<<Processes: public test auxiliary>>=
	public :: prepare_test_process
	<<Processes: test auxiliary>>=
	subroutine prepare_test_process &
	(process, process_instance, model, var_list, run_id)
	type(process_t), intent(out), target :: process
	type(process_instance_t), intent(out), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(var_list_t), intent(inout), optional :: var_list
	type(string_t), intent(in), optional :: run_id
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), allocatable, target :: process_model
	class(mci_t), pointer :: mci
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	libname = "processes_test"
	procname = libname
	call os_data%init ()
	call prc_test_create_library (libname, lib)
	call reset_interaction_counter ()
	allocate (process_model)
	call process_model%init (model%get_name (), &
	model%get_n_real (), &
	model%get_n_complex (), &
	model%get_n_field (), &
	model%get_n_vtx ())
	call process_model%copy_from (model)
	call process%init (procname, lib, os_data, process_model, var_list)
	if (present (run_id)) call process%set_run_id (run_id)
	call process%setup_test_cores ()
	allocate (phs_test_config_t :: phs_config_template)
	call process%init_components (phs_config_template)
	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()
	call process%setup_mci (dispatch_mci_test10)
	call process%setup_terms ()
	call process_instance%init (process)
	call process%test_get_mci_ptr (mci)
	select type (mci)
	type is (mci_test_t)
	! This ensures that the next 'random' numbers are 0.3, 0.5, 0.7
	call mci%rng%init (3)
	! Include the constant PHS factor in the stored maximum of the integrand
	call mci%set_max_factor (conv * twopi4 &
	/ (2 * sqrt (lambda (sqrts 2, 125._default2, 125._default**2))))
	end select
	call process%reset_library_ptr () ! avoid dangling pointer
	call process_model%final ()
	end subroutine prepare_test_process

	@ %def prepare_test_process
	@ Here we do the cleanup of the process and process instance emitted
	by the previous routine.
	<<Processes: public test auxiliary>>=
	public :: cleanup_test_process
	<<Processes: test auxiliary>>=
	subroutine cleanup_test_process (process, process_instance)
	type(process_t), intent(inout) :: process
	type(process_instance_t), intent(inout) :: process_instance
	call process_instance%final ()
	call process%final ()
	end subroutine cleanup_test_process

	@ %def cleanup_test_process
	@
	This is the actual test. Prepare the test process and event, fill
	all evaluators, and display the results. Use a particle set as
	temporary storage, read kinematics and recalculate the event.
	<<Processes: execute tests>>=
	call test (processes_12, "processes_12", &
	"event post-processing", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_12
	<<Processes: tests>>=
	subroutine processes_12 (u)
	integer, intent(in) :: u
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(particle_set_t) :: pset
	type(model_data_t), target :: model

	write (u, "(A)") "* Test output: processes_12"
	write (u, "(A)") "* Purpose: generate a complete partonic event"
	write (u, "(A)")

	call model%init_test ()

	write (u, "(A)") "* Build and initialize process and process instance &
	&and generate event"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model, &
	run_id = var_str ("run_12"))
	call process_instance%setup_event_data (i_core = 1)

	call process%prepare_simulation (1)
	call process_instance%init_simulation (1)
	call process_instance%generate_weighted_event (1)
	call process_instance%evaluate_event_data ()

	call process_instance%write (u)

	call process_instance%get_trace (pset, 1)

	call process_instance%final_simulation (1)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Recover kinematics and recalculate"
	write (u, "(A)")

	call reset_interaction_counter (2)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()

	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1, check_match = .false.)
	call process_instance%recover &
	(channel = 1, i_term = 1, update_sqme = .true., recover_phs = .true.)

	call process_instance%recover_event ()
	call process_instance%evaluate_event_data ()

	call process_instance%write (u)


	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_12"

	end subroutine processes_12

	@ %def processes_12
	@
	\subsubsection{Colored interaction}
	This test specifically checks the transformation of process data
	(flavor, helicity, and color) into an interaction in a process term.

	We use the [[test_t]] process core (which has no nontrivial
	particles), but call only the [[is_allowed]] method, which always
	returns true.
	<<Processes: execute tests>>=
	call test (processes_13, "processes_13", &
	"colored interaction", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_13
	<<Processes: tests>>=
	subroutine processes_13 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(process_term_t) :: term
	class(prc_core_t), allocatable :: core

	write (u, "(A)") "* Test output: processes_13"
	write (u, "(A)") "* Purpose: initialized a colored interaction"
	write (u, "(A)")

	write (u, "(A)") "* Set up a process constants block"
	write (u, "(A)")

	call os_data%init ()
	call model%init_sm_test ()

	allocate (test_t :: core)

	associate (data => term%data)
	data%n_in = 2
	data%n_out = 3
	data%n_flv = 2
	data%n_hel = 2
	data%n_col = 2
	data%n_cin = 2

	allocate (data%flv_state (5, 2))
	data%flv_state (:,1) = [ 1, 21, 1, 21, 21]
	data%flv_state (:,2) = [ 2, 21, 2, 21, 21]

	allocate (data%hel_state (5, 2))
	data%hel_state (:,1) = [1, 1, 1, 1, 0]
	data%hel_state (:,2) = [1,-1, 1,-1, 0]

	allocate (data%col_state (2, 5, 2))
	data%col_state (:,:,1) = &
	reshape ([[1, 0], [2,-1], [3, 0], [2,-3], [0,0]], [2,5])
	data%col_state (:,:,2) = &
	reshape ([[1, 0], [2,-3], [3, 0], [2,-1], [0,0]], [2,5])

	allocate (data%ghost_flag (5, 2))
	data%ghost_flag(1:4,:) = .false.
	data%ghost_flag(5,:) = .true.

	end associate

	write (u, "(A)") "* Set up the interaction"
	write (u, "(A)")

	call reset_interaction_counter ()
	call term%setup_interaction (core, model)
	call term%int%basic_write (u)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_13"
	end subroutine processes_13

	@ %def processes_13
	@
	\subsubsection{MD5 sums}
	Configure a process with structure functions (multi-channel) and
	compute MD5 sums
	<<Processes: execute tests>>=
	call test (processes_14, "processes_14", &
	"process configuration and MD5 sum", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_14
	<<Processes: tests>>=
	subroutine processes_14 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable, target :: process
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	type(sf_config_t), dimension(:), allocatable :: sf_config
	type(sf_channel_t), dimension(3) :: sf_channel

	write (u, "(A)") "* Test output: processes_14"
	write (u, "(A)") "* Purpose: initialize a process with &
	&structure functions"
	write (u, "(A)") "* and compute MD5 sum"
	write (u, "(A)")

	write (u, "(A)") "* Build and initialize a process object"
	write (u, "(A)")

	libname = "processes7"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)
	call lib%compute_md5sum ()

	call model%init_test ()

	allocate (process)
	call process%init (procname, lib, os_data, model)

	call process%setup_test_cores ()
	allocate (phs_test_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Set beam, structure functions, and mappings"
	write (u, "(A)")

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()

	pdg_in = 25
	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (process%get_model_ptr (), pdg_in)
	end select

	call process%test_allocate_sf_channels (3)

	allocate (sf_config (2))
	call sf_config(1)%init ([1], data)
	call sf_config(2)%init ([2], data)
	call process%init_sf_chain (sf_config)
	deallocate (sf_config)

	call sf_channel(1)%init (2)
	call process%set_sf_channel (1, sf_channel(1))

	call sf_channel(2)%init (2)
	call sf_channel(2)%activate_mapping ([1,2])
	call process%set_sf_channel (2, sf_channel(2))

	call sf_channel(3)%init (2)
	call sf_channel(3)%set_s_mapping ([1,2])
	call process%set_sf_channel (3, sf_channel(3))

	call process%setup_mci (dispatch_mci_empty)

	call process%compute_md5sum ()

	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_14"

	end subroutine processes_14

	@ %def processes_14
	@
	\subsubsection{Decay Process Evaluation}
	Initialize an evaluate a decay process.
	<<Processes: execute tests>>=
	call test (processes_15, "processes_15", &
	"decay process", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_15
	<<Processes: tests>>=
	subroutine processes_15 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable, target :: process
	class(phs_config_t), allocatable :: phs_config_template
	type(process_instance_t), allocatable, target :: process_instance
	type(particle_set_t) :: pset

	write (u, "(A)") "* Test output: processes_15"
	write (u, "(A)") "* Purpose: initialize a decay process object"
	write (u, "(A)")

	write (u, "(A)") "* Build and load a test library with one process"
	write (u, "(A)")

	libname = "processes15"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib, scattering = .false., &
	decay = .true.)

	call model%init_test ()
	call model%set_par (var_str ("ff"), 0.4_default)
	call model%set_par (var_str ("mf"), &
	model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))

	write (u, "(A)") "* Initialize a process object"
	write (u, "(A)")

	allocate (process)
	call process%init (procname, lib, os_data, model)

	call process%setup_test_cores ()
	allocate (phs_single_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Prepare a trivial beam setup"
	write (u, "(A)")

	call process%setup_beams_decay (i_core = 1)
	call process%configure_phs ()
	call process%setup_mci (dispatch_mci_empty)

	write (u, "(A)") "* Complete process initialization"
	write (u, "(A)")

	call process%setup_terms ()
	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance"
	write (u, "(A)")

	call reset_interaction_counter (3)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Inject a set of random numbers"
	write (u, "(A)")

	call process_instance%choose_mci (1)
	call process_instance%set_mcpar ([0._default, 0._default])
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Set up hard kinematics"
	write (u, "(A)")

	call process_instance%select_channel (1)
	call process_instance%compute_seed_kinematics ()
	call process_instance%compute_hard_kinematics ()

	write (u, "(A)") "* Evaluate matrix element and square"
	write (u, "(A)")

	call process_instance%compute_eff_kinematics ()
	call process_instance%evaluate_expressions ()
	call process_instance%compute_other_channels ()
	call process_instance%evaluate_trace ()
	call process_instance%write (u)

	call process_instance%get_trace (pset, 1)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Particle content:"
	write (u, "(A)")

	call write_separator (u)
	call pset%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover process instance"
	write (u, "(A)")

	call reset_interaction_counter (3)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1, check_match = .false.)
	call process_instance%recover (1, 1, .true., .true.)
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call pset%final ()
	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_15"

	end subroutine processes_15

	@ %def processes_15
	@
	\subsubsection{Integration: decay}
	Activate the MC integrator for the decay object and use it to
	integrate over phase space.
	<<Processes: execute tests>>=
	call test (processes_16, "processes_16", &
	"decay integration", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_16
	<<Processes: tests>>=
	subroutine processes_16 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable, target :: process
	class(phs_config_t), allocatable :: phs_config_template
	type(process_instance_t), allocatable, target :: process_instance

	write (u, "(A)") "* Test output: processes_16"
	write (u, "(A)") "* Purpose: integrate a process without &
	&structure functions"
	write (u, "(A)") "* in a multi-channel configuration"
	write (u, "(A)")

	write (u, "(A)") "* Build and initialize a process object"
	write (u, "(A)")

	libname = "processes16"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib, scattering = .false., &
	decay = .true.)

	call reset_interaction_counter ()

	call model%init_test ()
	call model%set_par (var_str ("ff"), 0.4_default)
	call model%set_par (var_str ("mf"), &
	model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))

	allocate (process)
	call process%init (procname, lib, os_data, model)

	call process%setup_test_cores ()
	allocate (phs_single_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Prepare a trivial beam setup"
	write (u, "(A)")

	call process%setup_beams_decay (i_core = 1)
	call process%configure_phs ()

	call process%setup_mci (dispatch_mci_test_midpoint)

	write (u, "(A)") "* Complete process initialization"
	write (u, "(A)")

	call process%setup_terms ()
	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance"
	write (u, "(A)")

	allocate (process_instance)
	call process_instance%init (process)

	write (u, "(A)") "* Integrate with default test parameters"
	write (u, "(A)")

	call process_instance%integrate (1, n_it=1, n_calls=10000)
	call process%final_integration (1)

	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A,ES13.7)") " Integral divided by phs factor = ", &
	process%get_integral (1) &
	/ process_instance%kin(1)%phs_factor

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_16"

	end subroutine processes_16

	@ %def processes_16
	@ MCI record prepared for midpoint integrator.
	<<Processes: test auxiliary>>=
	subroutine dispatch_mci_test_midpoint (mci, var_list, process_id, is_nlo)
	class(mci_t), allocatable, intent(out) :: mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	logical, intent(in), optional :: is_nlo
	allocate (mci_midpoint_t :: mci)
	end subroutine dispatch_mci_test_midpoint

	@ %def dispatch_mci_test_midpoint
	@
	\subsubsection{Decay Process Evaluation}
	Initialize an evaluate a decay process for a moving particle.
	<<Processes: execute tests>>=
	call test (processes_17, "processes_17", &
	"decay of moving particle", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_17
	<<Processes: tests>>=
	subroutine processes_17 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_t), allocatable, target :: process
	class(phs_config_t), allocatable :: phs_config_template
	type(process_instance_t), allocatable, target :: process_instance
	type(particle_set_t) :: pset
	type(flavor_t) :: flv_beam
	real(default) :: m, p, E

	write (u, "(A)") "* Test output: processes_17"
	write (u, "(A)") "* Purpose: initialize a decay process object"
	write (u, "(A)")

	write (u, "(A)") "* Build and load a test library with one process"
	write (u, "(A)")

	libname = "processes17"
	procname = libname

	call os_data%init ()

	call prc_test_create_library (libname, lib, scattering = .false., &
	decay = .true.)

	write (u, "(A)") "* Initialize a process object"
	write (u, "(A)")

	call model%init_test ()
	call model%set_par (var_str ("ff"), 0.4_default)
	call model%set_par (var_str ("mf"), &
	model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))

	allocate (process)
	call process%init (procname, lib, os_data, model)

	call process%setup_test_cores ()
	allocate (phs_single_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Prepare a trivial beam setup"
	write (u, "(A)")

	call process%setup_beams_decay (rest_frame = .false., i_core = 1)
	call process%configure_phs ()
	call process%setup_mci (dispatch_mci_empty)

	write (u, "(A)") "* Complete process initialization"
	write (u, "(A)")

	call process%setup_terms ()
	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance"
	write (u, "(A)")

	call reset_interaction_counter (3)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Set parent momentum and random numbers"
	write (u, "(A)")

	call process_instance%choose_mci (1)
	call process_instance%set_mcpar ([0._default, 0._default])

	call flv_beam%init (25, process%get_model_ptr ())
	m = flv_beam%get_mass ()
	p = 3 * m / 4
	E = sqrt (m2 + p2)
	call process_instance%set_beam_momenta ([vector4_moving (E, p, 3)])

	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Set up hard kinematics"
	write (u, "(A)")

	call process_instance%select_channel (1)
	call process_instance%compute_seed_kinematics ()
	call process_instance%compute_hard_kinematics ()

	write (u, "(A)") "* Evaluate matrix element and square"
	write (u, "(A)")

	call process_instance%compute_eff_kinematics ()
	call process_instance%evaluate_expressions ()
	call process_instance%compute_other_channels ()
	call process_instance%evaluate_trace ()
	call process_instance%write (u)

	call process_instance%get_trace (pset, 1)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Particle content:"
	write (u, "(A)")

	call write_separator (u)
	call pset%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover process instance"
	write (u, "(A)")

	call reset_interaction_counter (3)

	allocate (process_instance)
	call process_instance%init (process)

	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1, check_match = .false.)
	call process_instance%recover (1, 1, .true., .true.)
	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call pset%final ()
	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_17"

	end subroutine processes_17

	@ %def processes_17
	@
	\subsubsection{Resonances in Phase Space}
	This test demonstrates the extraction of the resonance-history set from the
	generated phase space. We need a nontrivial process, but no matrix element.
	This is provided by the [[prc_template]] method, using the [[SM]] model. We
	also need the [[phs_wood]] method, otherwise we would not have resonances in
	the phase space configuration.
	<<Processes: execute tests>>=
	call test (processes_18, "processes_18", &
	"extract resonance history set", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_18
	<<Processes: tests>>=
	subroutine processes_18 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(string_t) :: model_name
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	class(vars_t), pointer :: vars
	type(process_t), pointer :: process
	type(resonance_history_set_t) :: res_set
	integer :: i

	write (u, "(A)") "* Test output: processes_18"
	write (u, "(A)") "* Purpose: extra resonance histories"
	write (u, "(A)")

	write (u, "(A)") "* Build and load a test library with one process"
	write (u, "(A)")

	libname = "processes_18_lib"
	procname = "processes_18_p"

	call os_data%init ()

	call syntax_phs_forest_init ()

	model_name = "SM"
	model => null ()
	call prepare_model (model, model_name, vars)

	write (u, "(A)") "* Initialize a process library with one process"
	write (u, "(A)")

	select type (model)
	class is (model_t)
	call prepare_resonance_test_library (lib, libname, procname, model, os_data, u)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Initialize a process object with phase space"

	allocate (process)
	select type (model)
	class is (model_t)
	call prepare_resonance_test_process (process, lib, procname, model, os_data)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Extract resonance history set"
	write (u, "(A)")

	call process%extract_resonance_history_set (res_set)
	call res_set%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process%final ()
	deallocate (process)

	call model%final ()
	deallocate (model)

	call syntax_phs_forest_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_18"

	end subroutine processes_18

	@ %def processes_18
	@ Auxiliary subroutine that constructs the process library for the above test.
	<<Processes: test auxiliary>>=
	subroutine prepare_resonance_test_library &
	(lib, libname, procname, model, os_data, u)
	type(process_library_t), target, intent(out) :: lib
	type(string_t), intent(in) :: libname
	type(string_t), intent(in) :: procname
	type(model_t), intent(in), target :: model
	type(os_data_t), intent(in) :: os_data
	integer, intent(in) :: u
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry

	call lib%init (libname)

	allocate (prt_in (2), prt_out (3))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("d"), var_str ("ubar"), var_str ("W+")]

	allocate (template_me_def_t :: def)
	select type (def)
	type is (template_me_def_t)
	call def%init (model, prt_in, prt_out, unity = .false.)
	end select
	allocate (entry)
	call entry%init (procname, &
	model_name = model%get_name (), &
	n_in = 2, n_components = 1)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("template"), &
	variant = def)
	call entry%write (u)

	call lib%append (entry)

	call lib%configure (os_data)
	call lib%write_makefile (os_data, force = .true., verbose = .false.)
	call lib%clean (os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (os_data)

	end subroutine prepare_resonance_test_library

	@ %def prepare_resonance_test_library
	@ We want a test process which has been initialized up to the point where we
	can evaluate the matrix element. This is in fact rather complicated. We copy
	the steps from [[integration_setup_process]] in the [[integrate]] module,
	which is not available at this point.
	<<Processes: test auxiliary>>=
	subroutine prepare_resonance_test_process &
	(process, lib, procname, model, os_data)
	class(process_t), intent(out), target :: process
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: procname
	type(model_t), intent(in), target :: model
	type(os_data_t), intent(in) :: os_data
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts

	call process%init (procname, lib, os_data, model)

	allocate (phs_wood_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	call process%setup_test_cores (type_string = var_str ("template"))

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()
	call process%setup_mci (dispatch_mci_none)

	call process%setup_terms ()

	end subroutine prepare_resonance_test_process

	@ %def prepare_resonance_test_process
	@ MCI record prepared for the none (dummy) integrator.
	<<Processes: test auxiliary>>=
	subroutine dispatch_mci_none (mci, var_list, process_id, is_nlo)
	class(mci_t), allocatable, intent(out) :: mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	logical, intent(in), optional :: is_nlo
	allocate (mci_none_t :: mci)
	end subroutine dispatch_mci_none

	@ %def dispatch_mci_none
	@
	\subsubsection{Add after evaluate hook(s)}
	Initialize a process and process instance, add a trivial process hook,
	choose a sampling point and fill the process instance.

	We use the same trivial process as for the previous test. All
	momentum and state dependence is trivial, so we just test basic
	functionality.
	<<Processes: test types>>=
	type, extends(process_instance_hook_t) :: process_instance_hook_test_t
	integer :: unit
	character(len=15) :: name
	contains
	procedure :: init => process_instance_hook_test_init
	procedure :: final => process_instance_hook_test_final
	procedure :: evaluate => process_instance_hook_test_evaluate
	end type process_instance_hook_test_t

	@
	<<Processes: test auxiliary>>=
	subroutine process_instance_hook_test_init (hook, var_list, instance, pdf_data)
	class(process_instance_hook_test_t), intent(inout), target :: hook
	type(var_list_t), intent(in) :: var_list
	class(process_instance_t), intent(in), target :: instance
	type(pdf_data_t), intent(in), optional :: pdf_data
	end subroutine process_instance_hook_test_init

	subroutine process_instance_hook_test_final (hook)
	class(process_instance_hook_test_t), intent(inout) :: hook
	end subroutine process_instance_hook_test_final

	subroutine process_instance_hook_test_evaluate (hook, instance)
	class(process_instance_hook_test_t), intent(inout) :: hook
	class(process_instance_t), intent(in), target :: instance
	write (hook%unit, "(A)") "Execute hook:"
	write (hook%unit, "(2X,A,1X,A,I0,A)") hook%name, "(", len (trim (hook%name)), ")"
	end subroutine process_instance_hook_test_evaluate

	@
	<<Processes: execute tests>>=
	call test (processes_19, "processes_19", &
	"add trivial hooks to a process instance ", &
	u, results)
	<<Processes: test declarations>>=
	public :: processes_19
	<<Processes: tests>>=
	subroutine processes_19 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(process_t), allocatable, target :: process
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_instance_t) :: process_instance
	class(process_instance_hook_t), allocatable, target :: process_instance_hook, process_instance_hook2
	type(particle_set_t) :: pset

	write (u, "(A)") "* Test output: processes_19"
	write (u, "(A)") "* Purpose: allocate process instance &
	&and add an after evaluate hook"
	write (u, "(A)")

	write (u, "(A)")
	write (u, "(A)") "* Allocate a process instance"
	write (u, "(A)")

	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate hook and add to process instance"
	write (u, "(A)")

	allocate (process_instance_hook_test_t :: process_instance_hook)
	call process_instance%append_after_hook (process_instance_hook)

	allocate (process_instance_hook_test_t :: process_instance_hook2)
	call process_instance%append_after_hook (process_instance_hook2)

	select type (process_instance_hook)
	type is (process_instance_hook_test_t)
	process_instance_hook%unit = u
	process_instance_hook%name = "Hook 1"
	end select
	select type (process_instance_hook2)
	type is (process_instance_hook_test_t)
	process_instance_hook2%unit = u
	process_instance_hook2%name = "Hook 2"
	end select

	write (u, "(A)") "* Evaluate matrix element and square"
	write (u, "(A)")

	call process_instance%evaluate_after_hook ()

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process_instance_hook%final ()
	deallocate (process_instance_hook)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_19"

	end subroutine processes_19

	@ %def processes_19
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process Stacks}

	For storing and handling multiple processes, we define process stacks.
	These are ordinary stacks where new process entries are pushed onto
	the top. We allow for multiple entries with identical process ID, but
	distinct run ID.

	The implementation is essentially identical to the [[prclib_stacks]] module
	above. Unfortunately, Fortran supports no generic programming, so we do not
	make use of this fact.

	When searching for a specific process ID, we will get (a pointer to)
	the topmost process entry with that ID on the stack, which was entered
	last. Usually, this is the best version of the process (in terms of
	integral, etc.) Thus the stack terminology makes sense.
	<<[[process_stacks.f90]]>>=
	<<File header>>

	module process_stacks

	<<Use kinds>>
	<<Use strings>>
	use variables
	use process

	<<Standard module head>>

	<<Process stacks: public>>

	<<Process stacks: types>>

	interface
	<<Process stacks: sub interfaces>>
	end interface

	end module process_stacks
	@ %def process_stacks
	@
	<<[[process_stacks_sub.f90]]>>=
	<<File header>>

	submodule (process_stacks) process_stacks_s

	use io_units
	use format_utils, only: write_separator
	use diagnostics
	use observables

	implicit none

	contains

	<<Process stacks: procedures>>

	end submodule process_stacks_s

	@ %def process_stacks_s
	@
	\subsection{The process entry type}
	A process entry is a process object, augmented by a pointer to the
	next entry. We do not need specific methods, all relevant methods are
	inherited.

	On higher level, processes should be prepared as process entry objects.
	<<Process stacks: public>>=
	public :: process_entry_t
	<<Process stacks: types>>=
	type, extends (process_t) :: process_entry_t
	type(process_entry_t), pointer :: next => null ()
	end type process_entry_t

	@ %def process_entry_t
	@
	\subsection{The process stack type}
	For easy conversion and lookup it is useful to store the filling
	number in the object. The content is stored as a linked list.

	The [[var_list]] component stores process-specific results, so they
	can be retrieved as (pseudo) variables.

	The process stack can be linked to another one. This allows us to
	work with stacks of local scope.
	<<Process stacks: public>>=
	public :: process_stack_t
	<<Process stacks: types>>=
	type :: process_stack_t
	integer :: n = 0
	type(process_entry_t), pointer :: first => null ()
	type(var_list_t), pointer :: var_list => null ()
	type(process_stack_t), pointer :: next => null ()
	contains
	<<Process stacks: process stack: TBP>>
	end type process_stack_t

	@ %def process_stack_t
	@ Finalize partly: deallocate the process stack and variable list
	entries, but keep the variable list as an empty object. This way, the
	variable list links are kept.
	<<Process stacks: process stack: TBP>>=
	procedure :: clear => process_stack_clear
	<<Process stacks: sub interfaces>>=
	module subroutine process_stack_clear (stack)
	class(process_stack_t), intent(inout) :: stack
	end subroutine process_stack_clear
	<<Process stacks: procedures>>=
	module subroutine process_stack_clear (stack)
	class(process_stack_t), intent(inout) :: stack
	type(process_entry_t), pointer :: process
	if (associated (stack%var_list)) then
	call stack%var_list%final ()
	end if
	do while (associated (stack%first))
	process => stack%first
	stack%first => process%next
	call process%final ()
	deallocate (process)
	end do
	stack%n = 0
	end subroutine process_stack_clear

	@ %def process_stack_clear
	@ Finalizer. Clear and deallocate the variable list.
	<<Process stacks: process stack: TBP>>=
	procedure :: final => process_stack_final
	<<Process stacks: sub interfaces>>=
	module subroutine process_stack_final (object)
	class(process_stack_t), intent(inout) :: object
	end subroutine process_stack_final
	<<Process stacks: procedures>>=
	module subroutine process_stack_final (object)
	class(process_stack_t), intent(inout) :: object
	call object%clear ()
	if (associated (object%var_list)) then
	deallocate (object%var_list)
	end if
	end subroutine process_stack_final

	@ %def process_stack_final
	@ Output. The processes on the stack will be ordered LIFO, i.e.,
	backwards.
	<<Process stacks: process stack: TBP>>=
	procedure :: write => process_stack_write
	<<Process stacks: sub interfaces>>=
	recursive module subroutine process_stack_write (object, unit, pacify)
	class(process_stack_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	end subroutine process_stack_write
	<<Process stacks: procedures>>=
	recursive module subroutine process_stack_write (object, unit, pacify)
	class(process_stack_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	type(process_entry_t), pointer :: process
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	select case (object%n)
	case (0)
	write (u, "(1x,A)") "Process stack: [empty]"
	call write_separator (u, 2)
	case default
	write (u, "(1x,A)") "Process stack:"
	process => object%first
	do while (associated (process))
	call process%write (.false., u, pacify = pacify)
	process => process%next
	end do
	end select
	if (associated (object%next)) then
	write (u, "(1x,A)") "[Processes from context environment:]"
	call object%next%write (u, pacify)
	end if
	end subroutine process_stack_write

	@ %def process_stack_write
	@ The variable list is printed by a separate routine, since
	it should be linked to the global variable list, anyway.
	<<Process stacks: process stack: TBP>>=
	procedure :: write_var_list => process_stack_write_var_list
	<<Process stacks: sub interfaces>>=
	module subroutine process_stack_write_var_list (object, unit)
	class(process_stack_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine process_stack_write_var_list
	<<Process stacks: procedures>>=
	module subroutine process_stack_write_var_list (object, unit)
	class(process_stack_t), intent(in) :: object
	integer, intent(in), optional :: unit
	if (associated (object%var_list)) then
	call object%var_list%write (unit)
	end if
	end subroutine process_stack_write_var_list

	@ %def process_stack_write_var_list
	@ Short output.

	Since this is a stack, the default output ordering for each stack will be
	last-in, first-out. To enable first-in, first-out, which is more likely to be
	requested, there is an optional [[fifo]] argument.
	<<Process stacks: process stack: TBP>>=
	procedure :: show => process_stack_show
	<<Process stacks: sub interfaces>>=
	recursive module subroutine process_stack_show (object, unit, fifo)
	class(process_stack_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: fifo
	end subroutine process_stack_show
	<<Process stacks: procedures>>=
	recursive module subroutine process_stack_show (object, unit, fifo)
	class(process_stack_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: fifo
	type(process_entry_t), pointer :: process
	logical :: reverse
	integer :: u, i, j
	u = given_output_unit (unit)
	reverse = .false.; if (present (fifo)) reverse = fifo
	select case (object%n)
	case (0)
	case default
	if (.not. reverse) then
	process => object%first
	do while (associated (process))
	call process%show (u, verbose=.false.)
	process => process%next
	end do
	else
	do i = 1, object%n
	process => object%first
	do j = 1, object%n - i
	process => process%next
	end do
	call process%show (u, verbose=.false.)
	end do
	end if
	end select
	if (associated (object%next)) call object%next%show ()
	end subroutine process_stack_show

	@ %def process_stack_show
	@
	\subsection{Link}
	Link the current process stack to a global one.
	<<Process stacks: process stack: TBP>>=
	procedure :: link => process_stack_link
	<<Process stacks: sub interfaces>>=
	module subroutine process_stack_link (local_stack, global_stack)
	class(process_stack_t), intent(inout) :: local_stack
	type(process_stack_t), intent(in), target :: global_stack
	end subroutine process_stack_link
	<<Process stacks: procedures>>=
	module subroutine process_stack_link (local_stack, global_stack)
	class(process_stack_t), intent(inout) :: local_stack
	type(process_stack_t), intent(in), target :: global_stack
	local_stack%next => global_stack
	end subroutine process_stack_link

	@ %def process_stack_link
	@ Initialize the process variable list and link the main variable list
	to it.
	<<Process stacks: process stack: TBP>>=
	procedure :: init_var_list => process_stack_init_var_list
	<<Process stacks: sub interfaces>>=
	module subroutine process_stack_init_var_list (stack, var_list)
	class(process_stack_t), intent(inout) :: stack
	type(var_list_t), intent(inout), optional :: var_list
	end subroutine process_stack_init_var_list
	<<Process stacks: procedures>>=
	module subroutine process_stack_init_var_list (stack, var_list)
	class(process_stack_t), intent(inout) :: stack
	type(var_list_t), intent(inout), optional :: var_list
	allocate (stack%var_list)
	if (present (var_list)) call var_list%link (stack%var_list)
	end subroutine process_stack_init_var_list

	@ %def process_stack_init_var_list
	@ Link the process variable list to a global
	variable list.
	<<Process stacks: process stack: TBP>>=
	procedure :: link_var_list => process_stack_link_var_list
	<<Process stacks: sub interfaces>>=
	module subroutine process_stack_link_var_list (stack, var_list)
	class(process_stack_t), intent(inout) :: stack
	type(var_list_t), intent(in), target :: var_list
	end subroutine process_stack_link_var_list
	<<Process stacks: procedures>>=
	module subroutine process_stack_link_var_list (stack, var_list)
	class(process_stack_t), intent(inout) :: stack
	type(var_list_t), intent(in), target :: var_list
	call stack%var_list%link (var_list)
	end subroutine process_stack_link_var_list

	@ %def process_stack_link_var_list
	@
	\subsection{Push}
	We take a process pointer and push it onto the stack. The previous
	pointer is nullified. Subsequently, the process is `owned' by the
	stack and will be finalized when the stack is deleted.
	<<Process stacks: process stack: TBP>>=
	procedure :: push => process_stack_push
	<<Process stacks: sub interfaces>>=
	module subroutine process_stack_push (stack, process)
	class(process_stack_t), intent(inout) :: stack
	type(process_entry_t), intent(inout), pointer :: process
	end subroutine process_stack_push
	<<Process stacks: procedures>>=
	module subroutine process_stack_push (stack, process)
	class(process_stack_t), intent(inout) :: stack
	type(process_entry_t), intent(inout), pointer :: process
	process%next => stack%first
	stack%first => process
	process => null ()
	stack%n = stack%n + 1
	end subroutine process_stack_push

	@ %def process_stack_push
	@ Inverse: Remove the last process pointer in the list and return it.
	<<Process stacks: process stack: TBP>>=
	procedure :: pop_last => process_stack_pop_last
	<<Process stacks: sub interfaces>>=
	module subroutine process_stack_pop_last (stack, process)
	class(process_stack_t), intent(inout) :: stack
	type(process_entry_t), intent(inout), pointer :: process
	end subroutine process_stack_pop_last
	<<Process stacks: procedures>>=
	module subroutine process_stack_pop_last (stack, process)
	class(process_stack_t), intent(inout) :: stack
	type(process_entry_t), intent(inout), pointer :: process
	type(process_entry_t), pointer :: previous
	integer :: i
	select case (stack%n)
	case (:0)
	process => null ()
	case (1)
	process => stack%first
	stack%first => null ()
	stack%n = 0
	case (2:)
	process => stack%first
	do i = 2, stack%n
	previous => process
	process => process%next
	end do
	previous%next => null ()
	stack%n = stack%n - 1
	end select
	end subroutine process_stack_pop_last

	@ %def process_stack_pop_last
	@ Initialize process variables for a given process ID, without setting
	values.
	<<Process stacks: process stack: TBP>>=
	procedure :: init_result_vars => process_stack_init_result_vars
	<<Process stacks: sub interfaces>>=
	module subroutine process_stack_init_result_vars (stack, id)
	class(process_stack_t), intent(inout) :: stack
	type(string_t), intent(in) :: id
	end subroutine process_stack_init_result_vars
	<<Process stacks: procedures>>=
	module subroutine process_stack_init_result_vars (stack, id)
	class(process_stack_t), intent(inout) :: stack
	type(string_t), intent(in) :: id
	call var_list_init_num_id (stack%var_list, id)
	call var_list_init_process_results (stack%var_list, id)
	end subroutine process_stack_init_result_vars

	@ %def process_stack_init_result_vars
	@ Fill process variables with values. This is executed after the
	integration pass.

	Note: We set only integral and error. With multiple MCI records
	possible, the results for [[n_calls]], [[chi2]] etc. are not
	necessarily unique. (We might set the efficiency, though.)
	<<Process stacks: process stack: TBP>>=
	procedure :: fill_result_vars => process_stack_fill_result_vars
	<<Process stacks: sub interfaces>>=
	module subroutine process_stack_fill_result_vars (stack, id)
	class(process_stack_t), intent(inout) :: stack
	type(string_t), intent(in) :: id
	end subroutine process_stack_fill_result_vars
	<<Process stacks: procedures>>=
	module subroutine process_stack_fill_result_vars (stack, id)
	class(process_stack_t), intent(inout) :: stack
	type(string_t), intent(in) :: id
	type(process_t), pointer :: process
	process => stack%get_process_ptr (id)
	if (associated (process)) then
	call var_list_init_num_id (stack%var_list, id, process%get_num_id ())
	if (process%has_integral ()) then
	call var_list_init_process_results (stack%var_list, id, &
	integral = process%get_integral (), &
	error = process%get_error ())
	end if
	else
	call msg_bug ("process_stack_fill_result_vars: unknown process ID")
	end if
	end subroutine process_stack_fill_result_vars

	@ %def process_stack_fill_result_vars
	@ If one of the result variables has a local image in [[var_list_local]],
	update the value there as well.
	<<Process stacks: process stack: TBP>>=
	procedure :: update_result_vars => process_stack_update_result_vars
	<<Process stacks: sub interfaces>>=
	module subroutine process_stack_update_result_vars &
	(stack, id, var_list_local)
	class(process_stack_t), intent(inout) :: stack
	type(string_t), intent(in) :: id
	type(var_list_t), intent(inout) :: var_list_local
	end subroutine process_stack_update_result_vars
	<<Process stacks: procedures>>=
	module subroutine process_stack_update_result_vars (stack, id, var_list_local)
	class(process_stack_t), intent(inout) :: stack
	type(string_t), intent(in) :: id
	type(var_list_t), intent(inout) :: var_list_local
	call update ("integral(" // id // ")")
	call update ("error(" // id // ")")
	contains
	subroutine update (var_name)
	type(string_t), intent(in) :: var_name
	real(default) :: value
	if (var_list_local%contains (var_name, follow_link = .false.)) then
	value = stack%var_list%get_rval (var_name)
	call var_list_local%set_real (var_name, value, is_known = .true.)
	end if
	end subroutine update
	end subroutine process_stack_update_result_vars

	@ %def process_stack_update_result_vars
	@
	\subsection{Data Access}
	Tell if a process exists.
	<<Process stacks: process stack: TBP>>=
	procedure :: exists => process_stack_exists
	<<Process stacks: sub interfaces>>=
	module function process_stack_exists (stack, id) result (flag)
	class(process_stack_t), intent(in) :: stack
	type(string_t), intent(in) :: id
	logical :: flag
	end function process_stack_exists
	<<Process stacks: procedures>>=
	module function process_stack_exists (stack, id) result (flag)
	class(process_stack_t), intent(in) :: stack
	type(string_t), intent(in) :: id
	logical :: flag
	type(process_t), pointer :: process
	process => stack%get_process_ptr (id)
	flag = associated (process)
	end function process_stack_exists

	@ %def process_stack_exists
	@ Return a pointer to a process with specific ID. Look also at a
	linked stack, if necessary.
	<<Process stacks: process stack: TBP>>=
	procedure :: get_process_ptr => process_stack_get_process_ptr
	<<Process stacks: sub interfaces>>=
	recursive module function process_stack_get_process_ptr &
	(stack, id) result (ptr)
	class(process_stack_t), intent(in) :: stack
	type(string_t), intent(in) :: id
	type(process_t), pointer :: ptr
	end function process_stack_get_process_ptr
	<<Process stacks: procedures>>=
	recursive module function process_stack_get_process_ptr &
	(stack, id) result (ptr)
	class(process_stack_t), intent(in) :: stack
	type(string_t), intent(in) :: id
	type(process_t), pointer :: ptr
	type(process_entry_t), pointer :: entry
	ptr => null ()
	entry => stack%first
	do while (associated (entry))
	if (entry%get_id () == id) then
	ptr => entry%process_t
	return
	end if
	entry => entry%next
	end do
	if (associated (stack%next)) ptr => stack%next%get_process_ptr (id)
	end function process_stack_get_process_ptr

	@ %def process_stack_get_process_ptr
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[process_stacks_ut.f90]]>>=
	<<File header>>

	module process_stacks_ut
	use unit_tests
	use process_stacks_uti

	<<Standard module head>>

	<<Process stacks: public test>>

	contains

	<<Process stacks: test driver>>

	end module process_stacks_ut
	@ %def process_stacks_ut
	@
	<<[[process_stacks_uti.f90]]>>=
	<<File header>>

	module process_stacks_uti

	<<Use strings>>
	use os_interface
	use sm_qcd
	use models
	use model_data
	use variables, only: var_list_t
	use process_libraries
	use rng_base
	use prc_test, only: prc_test_create_library
	use process, only: process_t
	use instances, only: process_instance_t
	use processes_ut, only: prepare_test_process

	use process_stacks

	use rng_base_ut, only: rng_test_factory_t

	<<Standard module head>>

	<<Process stacks: test declarations>>

	contains

	<<Process stacks: tests>>

	end module process_stacks_uti

	@ %def process_stacks_uti
	@ API: driver for the unit tests below.
	<<Process stacks: public test>>=
	public :: process_stacks_test
	<<Process stacks: test driver>>=
	subroutine process_stacks_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Process stacks: execute tests>>
	end subroutine process_stacks_test

	@ %def process_stacks_test
	@
	\subsubsection{Write an empty process stack}
	The most trivial test is to write an uninitialized process stack.
	<<Process stacks: execute tests>>=
	call test (process_stacks_1, "process_stacks_1", &
	"write an empty process stack", &
	u, results)
	<<Process stacks: test declarations>>=
	public :: process_stacks_1
	<<Process stacks: tests>>=
	subroutine process_stacks_1 (u)
	integer, intent(in) :: u
	type(process_stack_t) :: stack

	write (u, "(A)") "* Test output: process_stacks_1"
	write (u, "(A)") "* Purpose: display an empty process stack"
	write (u, "(A)")

	call stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: process_stacks_1"

	end subroutine process_stacks_1

	@ %def process_stacks_1
	@
	\subsubsection{Fill a process stack}
	Fill a process stack with two (identical) processes.
	<<Process stacks: execute tests>>=
	call test (process_stacks_2, "process_stacks_2", &
	"fill a process stack", &
	u, results)
	<<Process stacks: test declarations>>=
	public :: process_stacks_2
	<<Process stacks: tests>>=
	subroutine process_stacks_2 (u)
	integer, intent(in) :: u
	type(process_stack_t) :: stack
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(var_list_t) :: var_list
	type(process_entry_t), pointer :: process => null ()

	write (u, "(A)") "* Test output: process_stacks_2"
	write (u, "(A)") "* Purpose: fill a process stack"
	write (u, "(A)")

	write (u, "(A)") "* Build, initialize and store two test processes"
	write (u, "(A)")

	libname = "process_stacks2"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)

	call model%init_test ()
	call var_list%append_string (var_str ("$run_id"))
	call var_list%append_log (var_str ("?alphas_is_fixed"), .true.)
	call var_list%append_int (var_str ("seed"), 0)

	allocate (process)

	call var_list%set_string &
	(var_str ("$run_id"), var_str ("run1"), is_known=.true.)
	call process%init (procname, lib, os_data, model, var_list)
	call stack%push (process)

	allocate (process)

	call var_list%set_string &
	(var_str ("$run_id"), var_str ("run2"), is_known=.true.)
	call process%init (procname, lib, os_data, model, var_list)
	call stack%push (process)

	call stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call stack%final ()
	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: process_stacks_2"

	end subroutine process_stacks_2

	@ %def process_stacks_2
	@
	\subsubsection{Fill a process stack}
	Fill a process stack with two (identical) processes.
	<<Process stacks: execute tests>>=
	call test (process_stacks_3, "process_stacks_3", &
	"process variables", &
	u, results)
	<<Process stacks: test declarations>>=
	public :: process_stacks_3
	<<Process stacks: tests>>=
	subroutine process_stacks_3 (u)
	integer, intent(in) :: u
	type(process_stack_t) :: stack
	type(model_t), target :: model
	type(string_t) :: procname
	type(process_entry_t), pointer :: process => null ()
	type(process_instance_t), target :: process_instance

	write (u, "(A)") "* Test output: process_stacks_3"
	write (u, "(A)") "* Purpose: setup process variables"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process variables"
	write (u, "(A)")

	procname = "processes_test"
	call model%init_test ()

	write (u, "(A)") "* Initialize process variables"
	write (u, "(A)")

	call stack%init_var_list ()
	call stack%init_result_vars (procname)
	call stack%write_var_list (u)

	write (u, "(A)")
	write (u, "(A)") "* Build and integrate a test process"
	write (u, "(A)")

	allocate (process)
	call prepare_test_process (process%process_t, process_instance, model)
	call process_instance%integrate (1, 1, 1000)
	call process_instance%final ()
	call process%final_integration (1)
	call stack%push (process)

	write (u, "(A)") "* Fill process variables"
	write (u, "(A)")

	call stack%fill_result_vars (procname)
	call stack%write_var_list (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call stack%final ()
	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: process_stacks_3"

	end subroutine process_stacks_3

	@ %def process_stacks_3
	@
	\subsubsection{Linked a process stack}
	Fill two process stack, linked to each other.
	<<Process stacks: execute tests>>=
	call test (process_stacks_4, "process_stacks_4", &
	"linked stacks", &
	u, results)
	<<Process stacks: test declarations>>=
	public :: process_stacks_4
	<<Process stacks: tests>>=
	subroutine process_stacks_4 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(process_stack_t), target :: stack1, stack2
	type(model_t), target :: model
	type(string_t) :: libname
	type(string_t) :: procname1, procname2
	type(os_data_t) :: os_data
	type(process_entry_t), pointer :: process => null ()

	write (u, "(A)") "* Test output: process_stacks_4"
	write (u, "(A)") "* Purpose: link process stacks"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process variables"
	write (u, "(A)")

	libname = "process_stacks_4_lib"
	procname1 = "process_stacks_4a"
	procname2 = "process_stacks_4b"

	call os_data%init ()

	write (u, "(A)") "* Initialize first process"
	write (u, "(A)")

	call prc_test_create_library (procname1, lib)

	call model%init_test ()

	allocate (process)
	call process%init (procname1, lib, os_data, model)
	call stack1%push (process)

	write (u, "(A)") "* Initialize second process"
	write (u, "(A)")

	call stack2%link (stack1)

	call prc_test_create_library (procname2, lib)

	allocate (process)

	call process%init (procname2, lib, os_data, model)
	call stack2%push (process)

	write (u, "(A)") "* Show linked stacks"
	write (u, "(A)")

	call stack2%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call stack2%final ()
	call stack1%final ()
	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: process_stacks_4"

	end subroutine process_stacks_4

	@ %def process_stacks_4
	@
	Index: trunk/src/me_methods/me_methods.nw
	===================================================================
	--- trunk/src/me_methods/me_methods.nw (revision 8903)
	+++ trunk/src/me_methods/me_methods.nw (revision 8904)
	@@ -1,8175 +1,8233 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: matrix elements and process libraries
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Interface for Matrix Element Objects}
	\includemodulegraph{me_methods}

	These modules manage internal and, in particular, external
	matrix-element code.
	\begin{description}
	\item[prc\_core]
	We define the abstract [[prc_core_t]] type which handles all specific
	features of kinematics matrix-element evaluation that depend on a particular
	class of processes. This abstract type supplements the
	[[prc_core_def_t]] type and related types in another module.
	Together, they provide a complete set of matrix-element handlers
	that are implemented in the concrete types below.
	\end{description}

	These are the implementations:
	\begin{description}
	\item[prc\_template\_me]
	Implements matrix-element code without actual content (trivial
	value), but full-fledged interface. This can be used for injecting
	user-defined matrix-element code.
	\item[prc\_omega]
	Matrix elements calculated by \oMega\ are the default for WHIZARD.
	Here, we provide all necessary support.
	\item[prc\_external]
	Matrix elements provided or using external (not \oMega) code or libraries.
	This is an abstract type, with concrete extensions below:
	\item[prc\_external\_test]
	Concrete implementation of the external-code type, actually using some
	pre-defined test matrix elements.
	\item[prc\_gosam]
	Interface for matrix elements computed using \gosam.
	\item[prc\_openloops]
	Interface for matrix elements computed using OpenLoops.
	\item[prc\_recola]
	Interface for matrix elements computed using Recola.
	\item[prc\_threshold]
	Interface for matrix elements for the top-pair threshold, that use external
	libraries.
	\end{description}


	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Abstract process core}
	In this module we provide abstract data types for process classes. Each
	process class represents a set of processes which are handled by a common
	``method'', e.g., by the \oMega\ matrix-element generator. The process class
	is also able to select a particular implementation for the phase-space and
	integration modules.

	For a complete implementation of a process class, we have to
	provide extensions of the following abstract types:
	\begin{description}
	\item[prc\_core\_def\_t] process and matrix-element configuration
	\item[prc\_writer\_t] (optional) writing external matrix-element code
	\item[prc\_driver\_t] accessing the matrix element (internal or external)
	\item[prc\_core\_t] evaluating kinematics and matrix element. The process
	core also selects phase-space and integrator implementations as appropriate
	for the process class and configuration.
	\end{description}

	In the actual process-handling data structures, each process component
	contains an instance of such a process class as its core. This allows us to
	keep the [[processes]] module below, which supervises matrix-element
	evaluation, integration, and event generation, free of any reference to
	concrete implementations (for the process class, phase space, and
	integrator).

	There are no unit tests, these are deferred to the [[processes]] module.
	<<[[prc_core.f90]]>>=
	<<File header>>
	module prc_core

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use diagnostics
	use os_interface, only: os_data_t
	use lorentz
	use interactions
	use variables, only: var_list_t
	use model_data, only: model_data_t

	use process_constants
	use prc_core_def
	use process_libraries
	use sf_base

	<<Standard module head>>

	<<Prc core: public>>

	<<Prc core: types>>

	<<Prc core: interfaces>>

	interface
	<<Prc core: sub interfaces>>
	end interface

	end module prc_core
	@ %def prc_core
	@
	<<[[prc_core_sub.f90]]>>=
	<<File header>>

	submodule (prc_core) prc_core_s

	!!! Intel oneAPI 2022/23 regression workaround
	use os_interface, only: os_data_t
	use model_data, only: model_data_t

	implicit none

	contains

	<<Prc core: procedures>>

	end submodule prc_core_s

	@ %def prc_core_s
	@
	\subsection{The process core}
	The process core is of abstract data type. Different types of matrix
	elements will be represented by different implementations.
	<<Prc core: public>>=
	public :: prc_core_t
	<<Prc core: types>>=
	type, abstract :: prc_core_t
	class(prc_core_def_t), pointer :: def => null ()
	logical :: data_known = .false.
	type(process_constants_t) :: data
	class(prc_core_driver_t), allocatable :: driver
	logical :: use_color_factors = .false.
	integer :: nc = 3
	contains
	<<Prc core: process core: TBP>>
	end type prc_core_t

	@ %def prc_core_t
	@ In any case there must be an output routine.
	<<Prc core: process core: TBP>>=
	procedure(prc_core_write), deferred :: write
	<<Prc core: interfaces>>=
	abstract interface
	subroutine prc_core_write (object, unit)
	import
	class(prc_core_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_core_write
	end interface

	@ %def prc_core_write
	@ Just type the name of the actual core method.
	<<Prc core: process core: TBP>>=
	procedure(prc_core_write_name), deferred :: write_name
	<<Prc core: interfaces>>=
	abstract interface
	subroutine prc_core_write_name (object, unit)
	import
	class(prc_core_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_core_write_name
	end interface

	@ %def prc_core_write_name
	@ For initialization, we assign a pointer to the process entry in the
	relevant library. This allows us to access all process functions via
	the implementation of [[prc_core_t]].

	We declare the [[object]] as [[intent(inout)]], since just after
	allocation it may be useful to store some extra data in the object,
	which we can then use in the actual initialization. This applies to
	extensions of [[prc_core]] which override the [[init]] method.
	<<Prc core: process core: TBP>>=
	procedure :: init => prc_core_init
	procedure :: base_init => prc_core_init
	<<Prc core: sub interfaces>>=
	module subroutine prc_core_init (object, def, lib, id, i_component)
	class(prc_core_t), intent(inout) :: object
	class(prc_core_def_t), intent(in), target :: def
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	end subroutine prc_core_init
	<<Prc core: procedures>>=
	module subroutine prc_core_init (object, def, lib, id, i_component)
	class(prc_core_t), intent(inout) :: object
	class(prc_core_def_t), intent(in), target :: def
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	object%def => def
	call lib%connect_process (id, i_component, object%data, object%driver)
	object%data_known = .true.
	end subroutine prc_core_init

	@ %def prc_core_init
	@ Return true if the matrix element generation was successful. This can be
	tested by looking at the number of generated flavor states, which should be
	nonzero.
	<<Prc core: process core: TBP>>=
	procedure :: has_matrix_element => prc_core_has_matrix_element
	<<Prc core: sub interfaces>>=
	module function prc_core_has_matrix_element (object) result (flag)
	class(prc_core_t), intent(in) :: object
	logical :: flag
	end function prc_core_has_matrix_element
	<<Prc core: procedures>>=
	module function prc_core_has_matrix_element (object) result (flag)
	class(prc_core_t), intent(in) :: object
	logical :: flag
	flag = object%data%n_flv /= 0
	end function prc_core_has_matrix_element

	@ %def prc_core_has_matrix_element
	@
	Return true if this process-core type needs extra code that has to be compiled
	and/or linked, beyond the default \oMega\ framework. This depends only on the
	concrete type, and the default is no.
	<<Prc core: process core: TBP>>=
	procedure, nopass :: needs_external_code => prc_core_needs_external_code
	<<Prc core: sub interfaces>>=
	module function prc_core_needs_external_code () result (flag)
	logical :: flag
	end function prc_core_needs_external_code
	<<Prc core: procedures>>=
	module function prc_core_needs_external_code () result (flag)
	logical :: flag
	flag = .false.
	end function prc_core_needs_external_code

	@ %def prc_core_needs_external_code
	@ The corresponding procedure to create and load extra libraries. The base
	procedure must not be called but has to be overridden, if extra code is
	required.
	<<Prc core: process core: TBP>>=
	procedure :: prepare_external_code => &
	prc_core_prepare_external_code
	<<Prc core: sub interfaces>>=
	module subroutine prc_core_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_core_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	end subroutine prc_core_prepare_external_code
	<<Prc core: procedures>>=
	module subroutine prc_core_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_core_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	call core%write ()
	call msg_bug ("prc_core_prepare_external_code called &
	&but not overridden")
	end subroutine prc_core_prepare_external_code

	@ %def prc_core_prepare_external_code
	@
	Return true if this process-core type uses the BLHA interface. This depends
	only on the concrete type, and the default is no.
	<<Prc core: process core: TBP>>=
	procedure, nopass :: uses_blha => prc_core_uses_blha
	<<Prc core: sub interfaces>>=
	module function prc_core_uses_blha () result (flag)
	logical :: flag
	end function prc_core_uses_blha
	<<Prc core: procedures>>=
	module function prc_core_uses_blha () result (flag)
	logical :: flag
	flag = .false.
	end function prc_core_uses_blha

	@ %def prc_core_uses_blha
	@
	Tell whether a particular combination of flavor/helicity/color state
	is allowed for the matrix element.
	<<Prc core: process core: TBP>>=
	procedure(prc_core_is_allowed), deferred :: is_allowed
	<<Prc core: interfaces>>=
	abstract interface
	function prc_core_is_allowed (object, i_term, f, h, c) result (flag)
	import
	class(prc_core_t), intent(in) :: object
	integer, intent(in) :: i_term, f, h, c
	logical :: flag
	end function prc_core_is_allowed
	end interface

	@ %def prc_core_is_allowed
	@ Set the constant process data for a specific term. By default,
	these are the constants stored inside the object, ignoring the term
	index. Type extensions may override this and provide term-specific data.
	<<Prc core: process core: TBP>>=
	procedure :: get_constants => prc_core_get_constants
	<<Prc core: sub interfaces>>=
	module subroutine prc_core_get_constants (object, data, i_term)
	class(prc_core_t), intent(in) :: object
	type(process_constants_t), intent(out) :: data
	integer, intent(in) :: i_term
	end subroutine prc_core_get_constants
	<<Prc core: procedures>>=
	module subroutine prc_core_get_constants (object, data, i_term)
	class(prc_core_t), intent(in) :: object
	type(process_constants_t), intent(out) :: data
	integer, intent(in) :: i_term
	data = object%data
	end subroutine prc_core_get_constants

	@ %def prc_core_get_constants
	@ The strong coupling is not among the process constants. The default
	implementation is to return a negative number, which indicates that $\alpha_s$
	is not available. This may be overridden by an implementation that provides
	an (event-specific) value. The value can be stored in the
	process-specific workspace.
	<<Prc core: process core: TBP>>=
	procedure :: get_alpha_s => prc_core_get_alpha_s
	<<Prc core: sub interfaces>>=
	module function prc_core_get_alpha_s (object, core_state) result (alpha_qcd)
	class(prc_core_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qcd
	end function prc_core_get_alpha_s
	<<Prc core: procedures>>=
	module function prc_core_get_alpha_s (object, core_state) result (alpha_qcd)
	class(prc_core_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qcd
	alpha_qcd = -1
	end function prc_core_get_alpha_s

	@ %def prc_core_get_alpha_s
	@ We follow the same strategy for the electromagnetic coupling
	$\alpha_\text{em}$.
	<<Prc core: process core: TBP>>=
	procedure :: get_alpha_qed => prc_core_get_alpha_qed
	<<Prc core: sub interfaces>>=
	module function prc_core_get_alpha_qed &
	(object, core_state) result (alpha_qed)
	class(prc_core_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qed
	end function prc_core_get_alpha_qed
	<<Prc core: procedures>>=
	module function prc_core_get_alpha_qed &
	(object, core_state) result (alpha_qed)
	class(prc_core_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qed
	alpha_qed = -1
	end function prc_core_get_alpha_qed

	@ %def prc_core_get_alpha_qed
	@
	Setup an index mapping for flavor structures and helicities that give
	the same matrix element. The index mapping is according to the order
	of flavor structures known to the [[prc_core]] class. This procedure
	here acts as a fallback in case there is no overridden procedure in
	the [[prc_core]] extension.
	<<Prc core: process core: TBP>>=
	procedure :: set_equivalent_flv_hel_indices => &
	prc_core_set_equivalent_flv_hel_indices
	<<Prc core: sub interfaces>>=
	module subroutine prc_core_set_equivalent_flv_hel_indices (object)
	class(prc_core_t), intent(inout) :: object
	end subroutine prc_core_set_equivalent_flv_hel_indices
	<<Prc core: procedures>>=
	module subroutine prc_core_set_equivalent_flv_hel_indices (object)
	class(prc_core_t), intent(inout) :: object
	integer :: i, n_flv, n_hel
	n_flv = object%data%n_flv
	n_hel = object%data%n_hel
	if (.not. allocated (object%data%eqv_flv_index)) &
	allocate (object%data%eqv_flv_index(n_flv))
	if (.not. allocated (object%data%eqv_hel_index)) &
	allocate (object%data%eqv_hel_index(n_hel))
	if (size (object%data%eqv_flv_index) /= n_flv) &
	call msg_bug ("BLHA Core: Size mismatch between eqv_flv_index and number of flavors.")
	if (size (object%data%eqv_hel_index) /= n_hel) &
	call msg_bug ("BLHA Core: Size mismatch between eqv_hel_index and number of helicities.")
	object%data%eqv_flv_index = [(i, i = 1, n_flv)]
	object%data%eqv_hel_index = [(i, i = 1, n_hel)]
	end subroutine prc_core_set_equivalent_flv_hel_indices

	@ %def prc_core_set_equivalent_flv_hel_indices
	@ Get the index mappings for flavor and helicity mappings set up in
	[[prc_core_get_equivalent_flv_index]] or any overriding variation.
	<<Prc core: process core: TBP>>=
	procedure :: get_equivalent_flv_index => prc_core_get_equivalent_flv_index
	procedure :: get_equivalent_hel_index => prc_core_get_equivalent_hel_index
	<<Prc core: sub interfaces>>=
	module function prc_core_get_equivalent_flv_index &
	(object) result (eqv_flv_index)
	class(prc_core_t), intent(in) :: object
	integer, dimension(:), allocatable :: eqv_flv_index
	end function prc_core_get_equivalent_flv_index
	module function prc_core_get_equivalent_hel_index &
	(object) result (eqv_hel_index)
	class(prc_core_t), intent(in) :: object
	integer, dimension(:), allocatable :: eqv_hel_index
	end function prc_core_get_equivalent_hel_index
	<<Prc core: procedures>>=
	module function prc_core_get_equivalent_flv_index &
	(object) result (eqv_flv_index)
	class(prc_core_t), intent(in) :: object
	integer, dimension(:), allocatable :: eqv_flv_index
	eqv_flv_index = object%data%eqv_flv_index
	end function prc_core_get_equivalent_flv_index

	module function prc_core_get_equivalent_hel_index &
	(object) result (eqv_hel_index)
	class(prc_core_t), intent(in) :: object
	integer, dimension(:), allocatable :: eqv_hel_index
	eqv_hel_index = object%data%eqv_hel_index
	end function prc_core_get_equivalent_hel_index

	@ %def prc_core_get_equivalent_flv_index prc_core_get_equivalent_hel_index
	@ Allocate the workspace associated to a process component. The default is
	that there is no workspace, so we do nothing. A type extension may override
	this and allocate a workspace object of appropriate type, which can be used in
	further calculations.

	In any case, the [[intent(out)]] attribute deletes any previously allocated
	workspace.
	<<Prc core: process core: TBP>>=
	procedure :: allocate_workspace => prc_core_ignore_workspace
	<<Prc core: sub interfaces>>=
	module subroutine prc_core_ignore_workspace (object, core_state)
	class(prc_core_t), intent(in) :: object
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_core_ignore_workspace
	<<Prc core: procedures>>=
	module subroutine prc_core_ignore_workspace (object, core_state)
	class(prc_core_t), intent(in) :: object
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_core_ignore_workspace

	@ %def prc_core_ignore_workspace
	@ Compute the momenta in the hard interaction, taking the seed
	kinematics as input. The [[i_term]] index tells us which term we want
	to compute. (The standard method is to just transfer the momenta to the hard
	interaction.)
	<<Prc core: process core: TBP>>=
	procedure(prc_core_compute_hard_kinematics), deferred :: &
	compute_hard_kinematics
	<<Prc core: interfaces>>=
	abstract interface
	subroutine prc_core_compute_hard_kinematics &
	(object, p_seed, i_term, int_hard, core_state)
	import
	class(prc_core_t), intent(in) :: object
	type(vector4_t), dimension(:), intent(in) :: p_seed
	integer, intent(in) :: i_term
	type(interaction_t), intent(inout) :: int_hard
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_core_compute_hard_kinematics
	end interface

	@ %def prc_core_compute_hard_kinematics
	@ Compute the momenta in the effective interaction, taking the hard
	kinematics as input. (This is called only if parton recombination is to be
	applied for the process variant.)
	<<Prc core: process core: TBP>>=
	procedure(prc_core_compute_eff_kinematics), deferred :: &
	compute_eff_kinematics
	<<Prc core: interfaces>>=
	abstract interface
	subroutine prc_core_compute_eff_kinematics &
	(object, i_term, int_hard, int_eff, core_state)
	import
	class(prc_core_t), intent(in) :: object
	integer, intent(in) :: i_term
	type(interaction_t), intent(in) :: int_hard
	type(interaction_t), intent(inout) :: int_eff
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_core_compute_eff_kinematics
	end interface

	@ %def prc_core_compute_eff_kinematics
	@ The process core must implement this function. Here, [[j]] is the index
	of the particular term we want to compute. The amplitude may depend on the
	factorization and renormalization scales.

	The [[core_state]] (workspace) argument may be used if it is provided by the caller.
	Otherwise, the routine should compute the result directly.
	<<Prc core: process core: TBP>>=
	procedure(prc_core_compute_amplitude), deferred :: compute_amplitude
	<<Prc core: interfaces>>=
	abstract interface
	function prc_core_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	import
	complex(default) :: amp
	class(prc_core_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: &
	core_state
	end function prc_core_compute_amplitude
	end interface

	@ %def prc_core_compute_amplitude
	@
	\subsection{Storage for intermediate results}

	The abstract [[prc_core_state_t]] type allows process cores to set up temporary
	workspace. The object is an extra argument for each of the individual
	calculations between kinematics setup and matrix-element evaluation.
	<<Prc core: public>>=
	public :: prc_core_state_t
	<<Prc core: types>>=
	type, abstract :: prc_core_state_t
	contains
	procedure(workspace_write), deferred :: write
	procedure(workspace_reset_new_kinematics), deferred :: reset_new_kinematics
	end type prc_core_state_t

	@ %def prc_core_state_t
	@ For debugging, we should at least have an output routine.
	<<Prc core: interfaces>>=
	abstract interface
	subroutine workspace_write (object, unit)
	import
	class(prc_core_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine workspace_write
	end interface

	@ %def workspace_write
	@ This is used during the NLO calculation, see there for more information.
	<<Prc core: interfaces>>=
	abstract interface
	subroutine workspace_reset_new_kinematics (object)
	import
	class(prc_core_state_t), intent(inout) :: object
	end subroutine workspace_reset_new_kinematics
	end interface

	@ %def workspace_reset_new_kinematics
	@
	\subsection{Helicity selection data}
	This is intended for use with \oMega, but may also be made available to other
	process methods. We set thresholds for counting the times a specific
	helicity amplitude is zero. When the threshold is reached, we skip this
	amplitude in subsequent calls.

	For initializing the helicity counters, we need an object that holds the two
	parameters, the threshold (large real number) and the cutoff (integer).

	A helicity value suppressed by more than [[threshold]] (a value which
	multiplies [[epsilon]], to be compared with the average of the current
	amplitude, default is $10^{10}$) is treated as zero. A matrix element is
	assumed to be zero and not called again if it has been zero [[cutoff]] times.
	<<Prc core: public>>=
	public :: helicity_selection_t
	<<Prc core: types>>=
	type :: helicity_selection_t
	logical :: active = .false.
	real(default) :: threshold = 0
	integer :: cutoff = 0
	contains
	<<Prc core: helicity selection: TBP>>
	end type helicity_selection_t

	@ %def helicity_selection_t
	@ Output. If the selection is inactive, print nothing.
	<<Prc core: helicity selection: TBP>>=
	procedure :: write => helicity_selection_write
	<<Prc core: sub interfaces>>=
	module subroutine helicity_selection_write (object, unit)
	class(helicity_selection_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine helicity_selection_write
	<<Prc core: procedures>>=
	module subroutine helicity_selection_write (object, unit)
	class(helicity_selection_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	if (object%active) then
	write (u, "(3x,A)") "Helicity selection data:"
	write (u, "(5x,A,ES17.10)") &
	"threshold =", object%threshold
	write (u, "(5x,A,I0)") &
	"cutoff = ", object%cutoff
	end if
	end subroutine helicity_selection_write

	@ %def helicity_selection_write
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Test process type}
	For the following tests, we define a simple implementation of the abstract
	[[prc_core_t]], designed such as to complement the [[prc_test_t]]
	process definition type.

	Note that it is not given that the actual process is defined as
	[[prc_test_t]] type. We enforce this by calling
	[[prc_test_create_library]]. The driver component in the process core
	will then become of type [[prc_test_t]].
	@
	<<[[prc_test_core.f90]]>>=
	<<File header>>

	module prc_test_core

	<<Use kinds>>
	use lorentz
	use interactions
	use prc_test
	use prc_core

	<<Standard module head>>

	<<Prc test core: public>>

	<<Prc test core: types>>

	interface
	<<Prc test core: sub interfaces>>
	end interface

	end module prc_test_core
	@ %def prc_test_core
	@
	<<[[prc_test_core_sub.f90]]>>=
	<<File header>>

	submodule (prc_test_core) prc_test_core_s

	use io_units

	implicit none

	contains

	<<Prc test core: procedures>>

	end submodule prc_test_core_s

	@ %def prc_test_core_s
	@
	<<Prc test core: public>>=
	public :: test_t
	<<Prc test core: types>>=
	type, extends (prc_core_t) :: test_t
	contains
	<<Prc test core: test type: TBP>>
	end type test_t

	@ %def test_t
	<<Prc test core: test type: TBP>>=
	procedure :: write => test_write
	<<Prc test core: sub interfaces>>=
	module subroutine test_write (object, unit)
	class(test_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine test_write
	<<Prc test core: procedures>>=
	module subroutine test_write (object, unit)
	class(test_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A)") "test type implementing prc_test"
	end subroutine test_write

	@ %def test_write
	<<Prc test core: test type: TBP>>=
	procedure :: write_name => test_write_name
	<<Prc test core: sub interfaces>>=
	module subroutine test_write_name (object, unit)
	class(test_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine test_write_name
	<<Prc test core: procedures>>=
	module subroutine test_write_name (object, unit)
	class(test_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u,"(1x,A)") "Core: prc_test"
	end subroutine test_write_name

	@ %def test_write_name
	@ This process type always needs a MC parameter set and a
	single term. This only state is always allowed.
	<<Prc test core: test type: TBP>>=
	procedure :: needs_mcset => test_needs_mcset
	procedure :: get_n_terms => test_get_n_terms
	procedure :: is_allowed => test_is_allowed
	<<Prc test core: sub interfaces>>=
	module function test_needs_mcset (object) result (flag)
	class(test_t), intent(in) :: object
	logical :: flag
	end function test_needs_mcset
	module function test_get_n_terms (object) result (n)
	class(test_t), intent(in) :: object
	integer :: n
	end function test_get_n_terms
	module function test_is_allowed (object, i_term, f, h, c) result (flag)
	class(test_t), intent(in) :: object
	integer, intent(in) :: i_term, f, h, c
	logical :: flag
	end function test_is_allowed
	<<Prc test core: procedures>>=
	module function test_needs_mcset (object) result (flag)
	class(test_t), intent(in) :: object
	logical :: flag
	flag = .true.
	end function test_needs_mcset

	module function test_get_n_terms (object) result (n)
	class(test_t), intent(in) :: object
	integer :: n
	n = 1
	end function test_get_n_terms

	module function test_is_allowed (object, i_term, f, h, c) result (flag)
	class(test_t), intent(in) :: object
	integer, intent(in) :: i_term, f, h, c
	logical :: flag
	flag = .true.
	end function test_is_allowed

	@ %def test_needs_mcset
	@ %def test_get_n_terms
	@ %def test_is_allowed
	@ Transfer the generated momenta directly to the hard interaction in
	the (only) term. We assume that everything has been set up correctly,
	so the array fits.
	<<Prc test core: test type: TBP>>=
	procedure :: compute_hard_kinematics => test_compute_hard_kinematics
	<<Prc test core: sub interfaces>>=
	module subroutine test_compute_hard_kinematics &
	(object, p_seed, i_term, int_hard, core_state)
	class(test_t), intent(in) :: object
	type(vector4_t), dimension(:), intent(in) :: p_seed
	integer, intent(in) :: i_term
	type(interaction_t), intent(inout) :: int_hard
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine test_compute_hard_kinematics
	<<Prc test core: procedures>>=
	module subroutine test_compute_hard_kinematics &
	(object, p_seed, i_term, int_hard, core_state)
	class(test_t), intent(in) :: object
	type(vector4_t), dimension(:), intent(in) :: p_seed
	integer, intent(in) :: i_term
	type(interaction_t), intent(inout) :: int_hard
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	call int_hard%set_momenta (p_seed)
	end subroutine test_compute_hard_kinematics

	@ %def test_compute_hard_kinematics
	@ This procedure is not called for [[test_t]], just a placeholder.
	<<Prc test core: test type: TBP>>=
	procedure :: compute_eff_kinematics => test_compute_eff_kinematics
	<<Prc test core: sub interfaces>>=
	module subroutine test_compute_eff_kinematics &
	(object, i_term, int_hard, int_eff, core_state)
	class(test_t), intent(in) :: object
	integer, intent(in) :: i_term
	type(interaction_t), intent(in) :: int_hard
	type(interaction_t), intent(inout) :: int_eff
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine test_compute_eff_kinematics
	<<Prc test core: procedures>>=
	module subroutine test_compute_eff_kinematics &
	(object, i_term, int_hard, int_eff, core_state)
	class(test_t), intent(in) :: object
	integer, intent(in) :: i_term
	type(interaction_t), intent(in) :: int_hard
	type(interaction_t), intent(inout) :: int_eff
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine test_compute_eff_kinematics

	@ %def test_compute_eff_kinematics
	@ Transfer the incoming momenta of [[p_seed]] directly to the
	effective interaction, and vice versa for the outgoing momenta.

	[[int_hard]] is left untouched since [[int_eff]] is an alias (via
	pointer) to it.
	<<Prc test core: test type: TBP>>=
	procedure :: recover_kinematics => test_recover_kinematics
	<<Prc test core: sub interfaces>>=
	module subroutine test_recover_kinematics &
	(object, p_seed, int_hard, int_eff, core_state)
	class(test_t), intent(in) :: object
	type(vector4_t), dimension(:), intent(inout) :: p_seed
	type(interaction_t), intent(inout) :: int_hard
	type(interaction_t), intent(inout) :: int_eff
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine test_recover_kinematics
	<<Prc test core: procedures>>=
	module subroutine test_recover_kinematics &
	(object, p_seed, int_hard, int_eff, core_state)
	class(test_t), intent(in) :: object
	type(vector4_t), dimension(:), intent(inout) :: p_seed
	type(interaction_t), intent(inout) :: int_hard
	type(interaction_t), intent(inout) :: int_eff
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	integer :: n_in
	n_in = int_eff%get_n_in ()
	call int_eff%set_momenta (p_seed(1:n_in), outgoing = .false.)
	p_seed(n_in+1:) = int_eff%get_momenta (outgoing = .true.)
	end subroutine test_recover_kinematics

	@ %def test_recover_kinematics
	@ Compute the amplitude. The driver ignores all quantum numbers and,
	in fact, returns a constant. Nevertheless, we properly transfer the
	momentum vectors.
	<<Prc test core: test type: TBP>>=
	procedure :: compute_amplitude => test_compute_amplitude
	<<Prc test core: sub interfaces>>=
	module function test_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(test_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: &
	core_state
	complex(default) :: amp
	end function test_compute_amplitude
	<<Prc test core: procedures>>=
	module function test_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(test_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: core_state
	complex(default) :: amp
	real(default), dimension(:,:), allocatable :: parray
	integer :: i, n_tot
	select type (driver => object%driver)
	type is (prc_test_t)
	if (driver%scattering) then
	n_tot = 4
	else
	n_tot = 3
	end if
	allocate (parray (0:3,n_tot))
	forall (i = 1:n_tot) parray(:,i) = vector4_get_components (p(i))
	amp = driver%get_amplitude (parray)
	end select
	end function test_compute_amplitude

	@ %def test_compute_amplitude
	@
	@
	\section{Template matrix elements}

	Here, we provide template matrix elements that are in structure
	very similar to \oMega\ matrix elements, but do not need its
	infrastructure. Per default, the matrix elements are flat, i.e.
	they have the constant value one. Analogous to the \oMega\
	implementation, this section implements the interface
	to the templates (via the makefile) and the driver.
	<<[[prc_template_me.f90]]>>=
	<<File header>>

	module prc_template_me

	use, intrinsic :: iso_c_binding !NODEP!

	use kinds
	<<Use strings>>
	use os_interface
	use lorentz
	use interactions
	use model_data

	use particle_specifiers, only: new_prt_spec
	use process_constants
	use prclib_interfaces
	use prc_core_def
	use process_libraries
	use prc_core

	<<Standard module head>>

	<<Template matrix elements: public>>

	<<Template matrix elements: types>>

	<<Template matrix elements: interfaces>>

	interface
	<<Template matrix elements: sub interfaces>>
	end interface

	contains

	<<Template matrix elements: main procedures>>

	end module prc_template_me
	@ %def prc_template_me
	@
	<<[[prc_template_me_sub.f90]]>>=
	<<File header>>

	submodule (prc_template_me) prc_template_me_s

	use io_units
	use system_defs, only: TAB
	use diagnostics
	use flavors

	implicit none

	contains

	<<Template matrix elements: procedures>>

	end submodule prc_template_me_s

	@ %def prc_template_me_s
	@
	\subsection{Process definition}
	For the process definition we implement an extension of the
	[[prc_core_def_t]] abstract type.
	<<Template matrix elements: public>>=
	public :: template_me_def_t
	<<Template matrix elements: types>>=
	type, extends (prc_core_def_t) :: template_me_def_t
	contains
	<<Template matrix elements: template ME def: TBP>>
	end type template_me_def_t

	@ %def template_me_def_t
	<<Template matrix elements: template ME def: TBP>>=
	procedure, nopass :: type_string => template_me_def_type_string
	<<Template matrix elements: sub interfaces>>=
	module function template_me_def_type_string () result (string)
	type(string_t) :: string
	end function template_me_def_type_string
	<<Template matrix elements: procedures>>=
	module function template_me_def_type_string () result (string)
	type(string_t) :: string
	string = "template"
	end function template_me_def_type_string

	@ %def template_me_def_type_string
	@ Initialization: allocate the writer for the template matrix element.
	Also set any data for this process that the writer needs.
	Gfortran 7/8/9 bug, has to remain in the main module.
	<<Template matrix elements: template ME def: TBP>>=
	procedure :: init => template_me_def_init
	<<Template matrix elements: main procedures>>=
	subroutine template_me_def_init &
	(object, model, prt_in, prt_out, unity)
	class(template_me_def_t), intent(out) :: object
	class(model_data_t), intent(in), target :: model
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	logical, intent(in) :: unity
	allocate (template_me_writer_t :: object%writer)
	select type (writer => object%writer)
	type is (template_me_writer_t)
	call writer%init (model, prt_in, prt_out, unity)
	end select
	end subroutine template_me_def_init

	@ %def template_me_def_init
	@ Write/read process- and method-specific data.
	<<Template matrix elements: template ME def: TBP>>=
	procedure :: write => template_me_def_write
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_def_write (object, unit)
	class(template_me_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine template_me_def_write
	<<Template matrix elements: procedures>>=
	module subroutine template_me_def_write (object, unit)
	class(template_me_def_t), intent(in) :: object
	integer, intent(in) :: unit
	select type (writer => object%writer)
	type is (template_me_writer_t)
	call writer%write (unit)
	end select
	end subroutine template_me_def_write

	@ %def template_me_def_write
	@
	<<Template matrix elements: template ME def: TBP>>=
	procedure :: read => template_me_def_read
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_def_read (object, unit)
	class(template_me_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine template_me_def_read
	<<Template matrix elements: procedures>>=
	module subroutine template_me_def_read (object, unit)
	class(template_me_def_t), intent(out) :: object
	integer, intent(in) :: unit
	call msg_bug &
	("WHIZARD template process definition: input not supported (yet)")
	end subroutine template_me_def_read

	@ %def template_me_def_read
	@ Allocate the driver for template matrix elements.
	Gfortran 7/8/9 bug, has to remain in the main module.
	<<Template matrix elements: template ME def: TBP>>=
	procedure :: allocate_driver => template_me_def_allocate_driver
	<<Template matrix elements: main procedures>>=
	subroutine template_me_def_allocate_driver (object, driver, basename)
	class(template_me_def_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	allocate (template_me_driver_t :: driver)
	end subroutine template_me_def_allocate_driver

	@ %def template_me_def_allocate_driver
	@ We need code:
	<<Template matrix elements: template ME def: TBP>>=
	procedure, nopass :: needs_code => template_me_def_needs_code
	<<Template matrix elements: sub interfaces>>=
	module function template_me_def_needs_code () result (flag)
	logical :: flag
	end function template_me_def_needs_code
	<<Template matrix elements: procedures>>=
	module function template_me_def_needs_code () result (flag)
	logical :: flag
	flag = .true.
	end function template_me_def_needs_code

	@ %def template_me_def_needs_code
	@ These are the features that a template matrix element provides.
	<<Template matrix elements: template ME def: TBP>>=
	procedure, nopass :: get_features => template_me_def_get_features
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_def_get_features (features)
	type(string_t), dimension(:), allocatable, intent(out) :: features
	end subroutine template_me_def_get_features
	<<Template matrix elements: procedures>>=
	module subroutine template_me_def_get_features (features)
	type(string_t), dimension(:), allocatable, intent(out) :: features
	allocate (features (5))
	features = [ &
	var_str ("init"), &
	var_str ("update_alpha_s"), &
	var_str ("is_allowed"), &
	var_str ("new_event"), &
	var_str ("get_amplitude")]
	end subroutine template_me_def_get_features

	@ %def template_me_def_get_features
	@ The interface of the specific features.
	<<Template matrix elements: interfaces>>=
	abstract interface
	subroutine init_t (par, scheme) bind(C)
	import
	real(c_default_float), dimension(*), intent(in) :: par
	integer(c_int), intent(in) :: scheme
	end subroutine init_t
	end interface

	abstract interface
	subroutine update_alpha_s_t (alpha_s) bind(C)
	import
	real(c_default_float), intent(in) :: alpha_s
	end subroutine update_alpha_s_t
	end interface

	abstract interface
	subroutine is_allowed_t (flv, hel, col, flag) bind(C)
	import
	integer(c_int), intent(in) :: flv, hel, col
	logical(c_bool), intent(out) :: flag
	end subroutine is_allowed_t
	end interface

	abstract interface
	subroutine new_event_t (p) bind(C)
	import
	real(c_default_float), dimension(0:3,*), intent(in) :: p
	end subroutine new_event_t
	end interface

	abstract interface
	subroutine get_amplitude_t (flv, hel, col, amp) bind(C)
	import
	integer(c_int), intent(in) :: flv, hel, col
	complex(c_default_complex), intent(out):: amp
	end subroutine get_amplitude_t
	end interface

	@ %def init_t update_alpha_s_t
	@ %def is_allowed_t new_event_t get_amplitude_t
	@ Connect the template matrix element features with the process driver.
	<<Template matrix elements: template ME def: TBP>>=
	procedure :: connect => template_me_def_connect
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_def_connect (def, lib_driver, i, proc_driver)
	class(template_me_def_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	end subroutine template_me_def_connect
	<<Template matrix elements: procedures>>=
	module subroutine template_me_def_connect (def, lib_driver, i, proc_driver)
	class(template_me_def_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	integer(c_int) :: pid, fid
	type(c_funptr) :: fptr
	select type (proc_driver)
	type is (template_me_driver_t)
	pid = i
	fid = 1
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%init)
	fid = 2
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%update_alpha_s)
	fid = 3
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%is_allowed)
	fid = 4
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%new_event)
	fid = 5
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%get_amplitude)
	end select
	end subroutine template_me_def_connect

	@ %def template_me_def_connect
	@
	\subsection{The Template Matrix element writer}
	Unlike \oMega, the template matrix element is directly written by the main
	\whizard\ program, so there will be no entry in the makefile for
	calling an external program. The template matrix element writer is
	responsible for writing interfaces and wrappers.
	<<Template matrix elements: types>>=
	type, extends (prc_writer_f_module_t) :: template_me_writer_t
	class(model_data_t), pointer :: model => null ()
	type(string_t) :: model_name
	logical :: unity
	type(string_t), dimension(:), allocatable :: prt_in
	type(string_t), dimension(:), allocatable :: prt_out
	integer :: n_in
	integer :: n_out
	integer :: n_tot
	contains
	<<Template matrix elements: template ME writer: TBP>>
	end type template_me_writer_t

	@ %def template_me_writer_t
	@ The reported type is the same as for the [[template_me_def_t]] type.
	<<Template matrix elements: template ME writer: TBP>>=
	procedure, nopass :: type_name => template_me_writer_type_name
	<<Template matrix elements: sub interfaces>>=
	module function template_me_writer_type_name () result (string)
	type(string_t) :: string
	end function template_me_writer_type_name
	<<Template matrix elements: procedures>>=
	module function template_me_writer_type_name () result (string)
	type(string_t) :: string
	string = "template"
	end function template_me_writer_type_name

	@ %def template_me_writer_type_name
	@ Taking into account the prefix for template ME module names.
	<<Template matrix elements: template ME writer: TBP>>=
	procedure, nopass :: get_module_name => template_me_writer_get_module_name
	<<Template matrix elements: sub interfaces>>=
	module function template_me_writer_get_module_name (id) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: id
	end function template_me_writer_get_module_name
	<<Template matrix elements: procedures>>=
	module function template_me_writer_get_module_name (id) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: id
	name = "tpr_" // id
	end function template_me_writer_get_module_name

	@ %def template_me_writer_get_module_name
	@ Output. This is called by [[template_me_def_write]].
	<<Template matrix elements: template ME writer: TBP>>=
	procedure :: write => template_me_writer_write
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_writer_write (object, unit)
	class(template_me_writer_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine template_me_writer_write
	<<Template matrix elements: procedures>>=
	module subroutine template_me_writer_write (object, unit)
	class(template_me_writer_t), intent(in) :: object
	integer, intent(in) :: unit
	integer :: i, j
	write (unit, "(5x,A,I0)") "# incoming part. = ", object%n_in
	write (unit, "(7x,A)", advance="no") &
	" Initial state: "
	do i = 1, object%n_in - 1
	write (unit, "(1x,A)", advance="no") char (object%prt_in(i))
	end do
	write (unit, "(1x,A)") char (object%prt_in(object%n_in))
	write (unit, "(5x,A,I0)") "# outgoing part. = ", object%n_out
	write (unit, "(7x,A)", advance="no") &
	" Final state: "
	do j = 1, object%n_out - 1
	write (unit, "(1x,A)", advance="no") char (object%prt_out(j))
	end do
	write (unit, "(1x,A)") char (object%prt_out(object%n_out))
	write (unit, "(5x,A,I0)") "# part. (total) = ", object%n_tot
	end subroutine template_me_writer_write

	@ %def template_me_writer_write
	@ Initialize with process data.
	<<Template matrix elements: template ME writer: TBP>>=
	procedure :: init => template_me_writer_init
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_writer_init (writer, model, &
	prt_in, prt_out, unity)
	class(template_me_writer_t), intent(out) :: writer
	class(model_data_t), intent(in), target :: model
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	logical, intent(in) :: unity
	end subroutine template_me_writer_init
	<<Template matrix elements: procedures>>=
	module subroutine template_me_writer_init (writer, model, &
	prt_in, prt_out, unity)
	class(template_me_writer_t), intent(out) :: writer
	class(model_data_t), intent(in), target :: model
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	logical, intent(in) :: unity
	writer%model => model
	writer%model_name = model%get_name ()
	writer%n_in = size (prt_in)
	writer%n_out = size (prt_out)
	writer%n_tot = size (prt_in) + size (prt_out)
	allocate (writer%prt_in (size (prt_in)), source = prt_in)
	allocate (writer%prt_out (size (prt_out)), source = prt_out)
	writer%unity = unity
	end subroutine template_me_writer_init

	@ %def template_me_writer_init
	@ The makefile is the driver file for the test matrix elements.
	<<Template matrix elements: template ME writer: TBP>>=
	procedure :: write_makefile_code => template_me_write_makefile_code
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_write_makefile_code &
	(writer, unit, id, os_data, verbose, testflag)
	class(template_me_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	end subroutine template_me_write_makefile_code
	<<Template matrix elements: procedures>>=
	module subroutine template_me_write_makefile_code &
	(writer, unit, id, os_data, verbose, testflag)
	class(template_me_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	write (unit, "(5A)") "SOURCES += ", char (id), ".f90"
	write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
	write (unit, "(5A)") "clean-", char (id), ":"
	if (verbose) then
	write (unit, "(5A)") TAB, "rm -f tpr_", char (id), ".mod"
	write (unit, "(5A)") TAB, "rm -f ", char (id), ".lo"
	else
	write (unit, "(5A)") TAB // '@echo " RM ', &
	trim (char (id)), '.mod"'
	write (unit, "(5A)") TAB, "@rm -f tpr_", char (id), ".mod"
	write (unit, "(5A)") TAB // '@echo " RM ', &
	trim (char (id)), '.lo"'
	write (unit, "(5A)") TAB, "@rm -f ", char (id), ".lo"
	end if
	write (unit, "(5A)") "CLEAN_SOURCES += ", char (id), ".f90"
	write (unit, "(5A)") "CLEAN_OBJECTS += tpr_", char (id), ".mod"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), ".lo"
	write (unit, "(5A)") char (id), ".lo: ", char (id), ".f90"
	if (.not. verbose) then
	write (unit, "(5A)") TAB // '@echo " FC " $@'
	end if
	write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"
	end subroutine template_me_write_makefile_code

	@ %def template_me_write_makefile_code
	@ The source is written by this routine.
	<<Template matrix elements: template ME writer: TBP>>=
	procedure :: write_source_code => template_me_write_source_code
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_write_source_code (writer, id)
	class(template_me_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine template_me_write_source_code
	<<Template matrix elements: procedures>>=
	module subroutine template_me_write_source_code (writer, id)
	class(template_me_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	integer, dimension(writer%n_in) :: prt_in, mult_in, col_in
	type(flavor_t), dimension(1:writer%n_in) :: flv_in
	integer, dimension(writer%n_out) :: prt_out, mult_out
	integer, dimension(writer%n_tot) :: prt, mult
	integer, dimension(:,:), allocatable :: sxxx
	integer :: dummy, status
	type(flavor_t), dimension(1:writer%n_out) :: flv_out
	type(string_t) :: proc_str, comment_str, col_str
	integer :: u, i, j
	integer :: hel, hel_in, hel_out, fac, factor, col_fac
	type(string_t) :: filename
	comment_str = ""
	do i = 1, writer%n_in
	comment_str = comment_str // writer%prt_in(i) // " "
	end do
	do j = 1, writer%n_out
	comment_str = comment_str // writer%prt_out(j) // " "
	end do
	do i = 1, writer%n_in
	prt_in(i) = writer%model%get_pdg (writer%prt_in(i))
	call flv_in(i)%init (prt_in(i), writer%model)
	mult_in(i) = flv_in(i)%get_multiplicity ()
	col_in(i) = abs (flv_in(i)%get_color_type ())
	mult(i) = mult_in(i)
	end do
	do j = 1, writer%n_out
	prt_out(j) = writer%model%get_pdg (writer%prt_out(j))
	call flv_out(j)%init (prt_out(j), writer%model)
	mult_out(j) = flv_out(j)%get_multiplicity ()
	mult(writer%n_in + j) = mult_out(j)
	end do
	prt(1:writer%n_in) = prt_in(1:writer%n_in)
	prt(writer%n_in+1:writer%n_tot) = prt_out(1:writer%n_out)
	proc_str = converter (prt)
	hel_in = product (mult_in)
	hel_out = product (mult_out)
	col_fac = product (col_in)
	hel = hel_in * hel_out
	fac = hel
	dummy = 1
	factor = 1
	if (writer%n_out >= 3) then
	do i = 3, writer%n_out
	factor = factor * (i - 2) * (i - 1)
	end do
	end if
	factor = factor * col_fac
	allocate (sxxx(1:hel,1:writer%n_tot))
	call create_spin_table (dummy,hel,fac,mult,sxxx)
	call msg_message ("Writing test matrix element for process '" &
	// char (id) // "'")
	filename = id // ".f90"
	u = free_unit ()
	open (unit=u, file=char(filename), action="write")
	write (u, "(A)") "! File generated automatically by WHIZARD"
	write (u, "(A)") "! "
	write (u, "(A)") "! Note that irresp. of what you demanded WHIZARD"
	write (u, "(A)") "! treats this as colorless process "
	write (u, "(A)") "! "
	write (u, "(A)") "module tpr_" // char(id)
	write (u, "(A)") " "
	write (u, "(A)") " use kinds"
	write (u, "(A)") " use omega_color, OCF => omega_color_factor"
	write (u, "(A)") " "
	write (u, "(A)") " implicit none"
	write (u, "(A)") " private"
	write (u, "(A)") " "
	write (u, "(A)") " public :: md5sum"
	write (u, "(A)") " public :: number_particles_in, number_particles_out"
	write (u, "(A)") " public :: number_spin_states, spin_states"
	write (u, "(A)") " public :: number_flavor_states, flavor_states"
	write (u, "(A)") " public :: number_color_flows, color_flows"
	write (u, "(A)") " public :: number_color_indices, number_color_factors, &"
	write (u, "(A)") " color_factors, color_sum, openmp_supported"
	write (u, "(A)") " public :: init, final, update_alpha_s"
	write (u, "(A)") " "
	write (u, "(A)") " public :: new_event, is_allowed, get_amplitude"
	write (u, "(A)") " "
	write (u, "(A)") " real(default), parameter :: &"
	write (u, "(A)") " & conv = 0.38937966e12_default"
	write (u, "(A)") " "
	write (u, "(A)") " real(default), parameter :: &"
	write (u, "(A)") " & pi = 3.1415926535897932384626433832795028841972_default"
	write (u, "(A)") " "
	write (u, "(A)") " real(default), parameter :: &"
	if (writer%unity) then
	write (u, "(A)") " & const = 1"
	else
	write (u, "(A,1x,I0,A)") " & const = (16 * pi / conv) * " &
	// "(16 * pi2)(", writer%n_out, "-2) "
	end if
	write (u, "(A)") " "
	write (u, "(A,1x,I0)") " integer, parameter, private :: n_prt = ", &
	writer%n_tot
	write (u, "(A,1x,I0)") " integer, parameter, private :: n_in = ", &
	writer%n_in
	write (u, "(A,1x,I0)") " integer, parameter, private :: n_out = ", &
	writer%n_out
	write (u, "(A)") " integer, parameter, private :: n_cflow = 1"
	write (u, "(A)") " integer, parameter, private :: n_cindex = 2"
	write (u, "(A)") " !!! We ignore tensor products and take only one flavor state."
	write (u, "(A)") " integer, parameter, private :: n_flv = 1"
	write (u, "(A,1x,I0)") " integer, parameter, private :: n_hel = ", hel
	write (u, "(A)") " "
	write (u, "(A)") " logical, parameter, private :: T = .true."
	write (u, "(A)") " logical, parameter, private :: F = .false."
	write (u, "(A)") " "
	do i = 1, hel
	write (u, "(A)") " integer, dimension(n_prt), parameter, private :: &"
	write (u, "(A)") " " // s_conv(i) // " = [ " // &
	char(converter(sxxx(i,1:writer%n_tot))) // " ]"
	end do
	write (u, "(A)") " integer, dimension(n_prt,n_hel), parameter, private :: table_spin_states = &"
	write (u, "(A)") " reshape ( [ & "
	do i = 1, hel-1
	write (u, "(A)") " " // s_conv(i) // ", & "
	end do
	write (u, "(A)") " " // s_conv(hel) // " & "
	write (u, "(A)") " ], [ n_prt, n_hel ] )"
	write (u, "(A)") " "
	write (u, "(A)") " integer, dimension(n_prt), parameter, private :: &"
	write (u, "(A)") " f0001 = [ " // char(proc_str) // " ] ! " // char(comment_str)
	write (u, "(A)") " integer, dimension(n_prt,n_flv), parameter, private :: table_flavor_states = &"
	write (u, "(A)") " reshape ( [ f0001 ], [ n_prt, n_flv ] )"
	write (u, "(A)") " "
	write (u, "(A)") " integer, dimension(n_cindex, n_prt), parameter, private :: &"
	!!! This produces non-matching color flows, better keep it completely colorless
	! write (u, "(A)") " c0001 = reshape ( [ " // char (dummy_colorizer (flv_in)) // &
	! " " // &
	select case (writer%n_in)
	case (1)
	col_str = "0,0,"
	case (2)
	col_str = "0,0,0,0,"
	end select
	write (u, "(A)") " c0001 = reshape ( [" // char (col_str) // &
	(repeat ("0,0, ", writer%n_out-1)) // "0,0 ], " // " [ n_cindex, n_prt ] )"
	write (u, "(A)") " integer, dimension(n_cindex, n_prt, n_cflow), parameter, private :: &"
	write (u, "(A)") " table_color_flows = reshape ( [ c0001 ], [ n_cindex, n_prt, n_cflow ] )"
	write (u, "(A)") " "
	write (u, "(A)") " logical, dimension(n_prt), parameter, private :: & "
	write (u, "(A)") " g0001 = [ " // (repeat ("F, ", writer%n_tot-1)) // "F ] "
	write (u, "(A)") " logical, dimension(n_prt, n_cflow), parameter, private " &
	// ":: table_ghost_flags = &"
	write (u, "(A)") " reshape ( [ g0001 ], [ n_prt, n_cflow ] )"
	write (u, "(A)") " "
	write (u, "(A)") " integer, parameter, private :: n_cfactors = 1"
	write (u, "(A)") " type(OCF), dimension(n_cfactors), parameter, private :: &"
	write (u, "(A)") " table_color_factors = [ OCF(1,1,+1._default) ]"
	write (u, "(A)") " "
	write (u, "(A)") " logical, dimension(n_flv), parameter, private :: a0001 = [ T ]"
	write (u, "(A)") " logical, dimension(n_flv, n_cflow), parameter, private :: &"
	write (u, "(A)") " flv_col_is_allowed = reshape ( [ a0001 ], [ n_flv, n_cflow ] )"
	write (u, "(A)") " "
	write (u, "(A)") " complex(default), dimension (n_flv, n_hel, n_cflow), private, save :: amp"
	write (u, "(A)") " "
	write (u, "(A)") " logical, dimension(n_hel), private, save :: hel_is_allowed = T"
	write (u, "(A)") " "
	write (u, "(A)") "contains"
	write (u, "(A)") " "
	write (u, "(A)") " pure function md5sum ()"
	write (u, "(A)") " character(len=32) :: md5sum"
	write (u, "(A)") " ! DON'T EVEN THINK of modifying the following line!"
	write (u, "(A)") " md5sum = """ // writer%md5sum // """"
	write (u, "(A)") " end function md5sum"
	write (u, "(A)") " "
	write (u, "(A)") " subroutine init (par, scheme)"
	write (u, "(A)") " real(default), dimension(*), intent(in) :: par"
	write (u, "(A)") " integer, intent(in) :: scheme"
	write (u, "(A)") " end subroutine init"
	write (u, "(A)") " "
	write (u, "(A)") " subroutine final ()"
	write (u, "(A)") " end subroutine final"
	write (u, "(A)") " "
	write (u, "(A)") " subroutine update_alpha_s (alpha_s)"
	write (u, "(A)") " real(default), intent(in) :: alpha_s"
	write (u, "(A)") " end subroutine update_alpha_s"
	write (u, "(A)") " "
	write (u, "(A)") " pure function number_particles_in () result (n)"
	write (u, "(A)") " integer :: n"
	write (u, "(A)") " n = n_in"
	write (u, "(A)") " end function number_particles_in"
	write (u, "(A)") " "
	write (u, "(A)") " pure function number_particles_out () result (n)"
	write (u, "(A)") " integer :: n"
	write (u, "(A)") " n = n_out"
	write (u, "(A)") " end function number_particles_out"
	write (u, "(A)") " "
	write (u, "(A)") " pure function number_spin_states () result (n)"
	write (u, "(A)") " integer :: n"
	write (u, "(A)") " n = size (table_spin_states, dim=2)"
	write (u, "(A)") " end function number_spin_states"
	write (u, "(A)") " "
	write (u, "(A)") " pure subroutine spin_states (a)"
	write (u, "(A)") " integer, dimension(:,:), intent(out) :: a"
	write (u, "(A)") " a = table_spin_states"
	write (u, "(A)") " end subroutine spin_states"
	write (u, "(A)") " "
	write (u, "(A)") " pure function number_flavor_states () result (n)"
	write (u, "(A)") " integer :: n"
	write (u, "(A)") " n = 1"
	write (u, "(A)") " end function number_flavor_states"
	write (u, "(A)") " "
	write (u, "(A)") " pure subroutine flavor_states (a)"
	write (u, "(A)") " integer, dimension(:,:), intent(out) :: a"
	write (u, "(A)") " a = table_flavor_states"
	write (u, "(A)") " end subroutine flavor_states"
	write (u, "(A)") " "
	write (u, "(A)") " pure function number_color_indices () result (n)"
	write (u, "(A)") " integer :: n"
	write (u, "(A)") " n = size(table_color_flows, dim=1)"
	write (u, "(A)") " end function number_color_indices"
	write (u, "(A)") " "
	write (u, "(A)") " pure subroutine color_factors (cf)"
	write (u, "(A)") " type(OCF), dimension(:), intent(out) :: cf"
	write (u, "(A)") " cf = table_color_factors"
	write (u, "(A)") " end subroutine color_factors"
	write (u, "(A)") " "
	!pure unless OpenMP
	!write (u, "(A)") " pure function color_sum (flv, hel) result (amp2)"
	write (u, "(A)") " function color_sum (flv, hel) result (amp2)"
	write (u, "(A)") " integer, intent(in) :: flv, hel"
	write (u, "(A)") " real(kind=default) :: amp2"
	write (u, "(A)") " amp2 = real (omega_color_sum (flv, hel, amp, table_color_factors))"
	write (u, "(A)") " end function color_sum"
	write (u, "(A)") " "
	write (u, "(A)") " pure function number_color_flows () result (n)"
	write (u, "(A)") " integer :: n"
	write (u, "(A)") " n = size (table_color_flows, dim=3)"
	write (u, "(A)") " end function number_color_flows"
	write (u, "(A)") " "
	write (u, "(A)") " pure subroutine color_flows (a, g)"
	write (u, "(A)") " integer, dimension(:,:,:), intent(out) :: a"
	write (u, "(A)") " logical, dimension(:,:), intent(out) :: g"
	write (u, "(A)") " a = table_color_flows"
	write (u, "(A)") " g = table_ghost_flags"
	write (u, "(A)") " end subroutine color_flows"
	write (u, "(A)") " "
	write (u, "(A)") " pure function number_color_factors () result (n)"
	write (u, "(A)") " integer :: n"
	write (u, "(A)") " n = size (table_color_factors)"
	write (u, "(A)") " end function number_color_factors"
	write (u, "(A)") " "
	write (u, "(A)") " pure function openmp_supported () result (status)"
	write (u, "(A)") " logical :: status"
	write (u, "(A)") " status = .false."
	write (u, "(A)") " end function openmp_supported"
	write (u, "(A)") " "
	write (u, "(A)") " subroutine new_event (p)"
	write (u, "(A)") " real(default), dimension(0:3,*), intent(in) :: p"
	write (u, "(A)") " call calculate_amplitudes (amp, p)"
	write (u, "(A)") " end subroutine new_event"
	write (u, "(A)") " "
	write (u, "(A)") " pure function is_allowed (flv, hel, col) result (yorn)"
	write (u, "(A)") " logical :: yorn"
	write (u, "(A)") " integer, intent(in) :: flv, hel, col"
	write (u, "(A)") " yorn = hel_is_allowed(hel) .and. flv_col_is_allowed(flv,col)"
	write (u, "(A)") " end function is_allowed"
	write (u, "(A)") " "
	write (u, "(A)") " pure function get_amplitude (flv, hel, col) result (amp_result)"
	write (u, "(A)") " complex(default) :: amp_result"
	write (u, "(A)") " integer, intent(in) :: flv, hel, col"
	write (u, "(A)") " amp_result = amp (flv, hel, col)"
	write (u, "(A)") " end function get_amplitude"
	write (u, "(A)") " "
	write (u, "(A)") " pure subroutine calculate_amplitudes (amp, k)"
	write (u, "(A)") " complex(default), dimension(:,:,:), intent(out) :: amp"
	write (u, "(A)") " real(default), dimension(0:3,*), intent(in) :: k"
	write (u, "(A)") " real(default) :: fac"
	write (u, "(A)") " integer :: i"
	write (u, "(A)") " ! We give all helicities the same weight!"
	if (writer%unity) then
	write (u, "(A,1x,I0,1x,A)") " fac = ", col_fac
	write (u, "(A)") " amp = const * sqrt(fac)"
	else
	write (u, "(A,1x,I0,1x,A)") " fac = ", factor
	write (u, "(A)") " amp = sqrt((2 * (k(0,1)*k(0,2) &"
	write (u, "(A,1x,I0,A)") " - dot_product (k(1:,1), k(1:,2)))) ** (3-", &
	writer%n_out, ")) * sqrt(const * fac)"
	end if
	write (u, "(A,1x,I0,A)") " amp = amp / sqrt(", hel_out, "._default)"
	write (u, "(A)") " end subroutine calculate_amplitudes"
	write (u, "(A)") " "
	write (u, "(A)") "end module tpr_" // char(id)
	close (u, iostat=status)
	deallocate (sxxx)
	contains
	function s_conv (num) result (chrt)
	integer, intent(in) :: num
	character(len=10) :: chrt
	write (chrt, "(I10)") num
	chrt = trim(adjustl(chrt))
	if (num < 10) then
	chrt = "s000" // chrt
	else if (num < 100) then
	chrt = "s00" // chrt
	else if (num < 1000) then
	chrt = "s0" // chrt
	else
	chrt = "s" // chrt
	end if
	end function s_conv
	function converter (flv) result (str)
	integer, dimension(:), intent(in) :: flv
	type(string_t) :: str
	character(len=150), dimension(size(flv)) :: chrt
	integer :: i
	str = ""
	do i = 1, size(flv) - 1
	write (chrt(i), "(I10)") flv(i)
	str = str // var_str(trim(adjustl(chrt(i)))) // ", "
	end do
	write (chrt(size(flv)), "(I10)") flv(size(flv))
	str = str // trim(adjustl(chrt(size(flv))))
	end function converter
	integer function sj (j,m)
	integer, intent(in) :: j, m
	if (((j == 1) .and. (m == 1)) .or. &
	((j == 2) .and. (m == 2)) .or. &
	((j == 3) .and. (m == 3)) .or. &
	((j == 4) .and. (m == 3)) .or. &
	((j == 5) .and. (m == 4))) then
	sj = 1
	else if (((j == 2) .and. (m == 1)) .or. &
	((j == 3) .and. (m == 1)) .or. &
	((j == 4) .and. (m == 2)) .or. &
	((j == 5) .and. (m == 2))) then
	sj = -1
	else if (((j == 3) .and. (m == 2)) .or. &
	((j == 5) .and. (m == 3))) then
	sj = 0
	else if (((j == 4) .and. (m == 1)) .or. &
	((j == 5) .and. (m == 1))) then
	sj = -2
	else if (((j == 4) .and. (m == 4)) .or. &
	((j == 5) .and. (m == 5))) then
	sj = 2
	else
	call msg_fatal ("template_me_write_source_code: Wrong spin type")
	end if
	end function sj
	recursive subroutine create_spin_table (index, nhel, fac, mult, inta)
	integer, intent(inout) :: index, fac
	integer, intent(in) :: nhel
	integer, dimension(:), intent(in) :: mult
	integer, dimension(nhel,size(mult)), intent(out) :: inta
	integer :: j
	if (index > size(mult)) return
	fac = fac / mult(index)
	do j = 1, nhel
	inta(j,index) = sj (mult(index),mod(((j-1)/fac),mult(index))+1)
	end do
	index = index + 1
	call create_spin_table (index, nhel, fac, mult, inta)
	end subroutine create_spin_table
	function dummy_colorizer (flv) result (str)
	type(flavor_t), dimension(:), intent(in) :: flv
	type(string_t) :: str
	integer :: i, k
	str = ""
	k = 0
	do i = 1, size(flv)
	k = k + 1
	select case (flv(i)%get_color_type ())
	case (1,-1)
	str = str // "0,0, "
	case (3)
	str = str // int2string(k) // ",0, "
	case (-3)
	str = str // "0," // int2string(-k) // ", "
	case (8)
	str = str // int2string(k) // "," // int2string(-k-1) // ", "
	k = k + 1
	case default
	call msg_error ("Color type not supported.")
	end select
	end do
	str = adjustl(trim(str))
	end function dummy_colorizer
	end subroutine template_me_write_source_code

	@ %def template_me_write_source_code
	@ Nothing to be done here.
	<<Template matrix elements: template ME writer: TBP>>=
	procedure :: before_compile => template_me_before_compile
	procedure :: after_compile => template_me_after_compile
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_before_compile (writer, id)
	class(template_me_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine template_me_before_compile
	module subroutine template_me_after_compile (writer, id)
	class(template_me_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine template_me_after_compile
	<<Template matrix elements: procedures>>=
	module subroutine template_me_before_compile (writer, id)
	class(template_me_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine template_me_before_compile

	module subroutine template_me_after_compile (writer, id)
	class(template_me_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine template_me_after_compile

	@ %def template_me_before_compile
	@ %def template_me_after_compile
	@ Return the name of a procedure that implements a given feature, as
	it is provided by the template matrix-element code. Template ME names
	are chosen completely in analogy to the \oMega\ matrix element
	conventions.
	<<Template matrix elements: template ME writer: TBP>>=
	procedure, nopass :: get_procname => template_me_writer_get_procname
	<<Template matrix elements: sub interfaces>>=
	module function template_me_writer_get_procname (feature) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: feature
	end function template_me_writer_get_procname
	<<Template matrix elements: procedures>>=
	module function template_me_writer_get_procname (feature) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: feature
	select case (char (feature))
	case ("n_in"); name = "number_particles_in"
	case ("n_out"); name = "number_particles_out"
	case ("n_flv"); name = "number_flavor_states"
	case ("n_hel"); name = "number_spin_states"
	case ("n_col"); name = "number_color_flows"
	case ("n_cin"); name = "number_color_indices"
	case ("n_cf"); name = "number_color_factors"
	case ("flv_state"); name = "flavor_states"
	case ("hel_state"); name = "spin_states"
	case ("col_state"); name = "color_flows"
	case default
	name = feature
	end select
	end function template_me_writer_get_procname

	@ %def template_me_writer_get_procname
	@ The interfaces for the template-specific features.
	<<Template matrix elements: template ME writer: TBP>>=
	procedure :: write_interface => template_me_write_interface
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_write_interface (writer, unit, id, feature)
	class(template_me_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(string_t), intent(in) :: feature
	end subroutine template_me_write_interface
	<<Template matrix elements: procedures>>=
	module subroutine template_me_write_interface (writer, unit, id, feature)
	class(template_me_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(string_t), intent(in) :: feature
	type(string_t) :: name
	name = writer%get_c_procname (id, feature)
	write (unit, "(2x,9A)") "interface"
	select case (char (feature))
	case ("init")
	write (unit, "(5x,9A)") "subroutine ", char (name), &
	" (par, scheme) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "real(c_default_float), dimension(*), &
	&intent(in) :: par"
	write (unit, "(7x,9A)") "integer(c_int), intent(in) :: scheme"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("update_alpha_s")
	write (unit, "(5x,9A)") "subroutine ", char (name), " (alpha_s) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "real(c_default_float), intent(in) :: alpha_s"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("is_allowed")
	write (unit, "(5x,9A)") "subroutine ", char (name), " &
	&(flv, hel, col, flag) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(7x,9A)") "logical(c_bool), intent(out) :: flag"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("new_event")
	write (unit, "(5x,9A)") "subroutine ", char (name), " (p) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "real(c_default_float), dimension(0:3,*), &
	&intent(in) :: p"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("get_amplitude")
	write (unit, "(5x,9A)") "subroutine ", char (name), " &
	&(flv, hel, col, amp) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(7x,9A)") "complex(c_default_complex), intent(out) &
	&:: amp"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	end select
	write (unit, "(2x,9A)") "end interface"
	end subroutine template_me_write_interface

	@ %def template_me_write_interface
	@ The wrappers have to take into account conversion between C and
	Fortran data types.

	NOTE: The case [[c_default_float]] $\neq$ [[default]] is not yet covered.
	<<Template matrix elements: template ME writer: TBP>>=
	procedure :: write_wrapper => template_me_write_wrapper
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_write_wrapper (writer, unit, id, feature)
	class(template_me_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	end subroutine template_me_write_wrapper
	<<Template matrix elements: procedures>>=
	module subroutine template_me_write_wrapper (writer, unit, id, feature)
	class(template_me_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	type(string_t) :: name
	name = writer%get_c_procname (id, feature)
	write (unit, *)
	select case (char (feature))
	case ("init")
	write (unit, "(9A)") "subroutine ", char (name), &
	" (par, scheme) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use tpr_", char (id)
	write (unit, "(2x,9A)") "real(c_default_float), dimension(*), &
	&intent(in) :: par"
	write (unit, "(2x,9A)") "integer(c_int), intent(in) :: scheme"
	if (c_default_float == default .and. c_int == kind(1)) then
	write (unit, "(2x,9A)") "call ", char (feature), " (par, scheme)"
	end if
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("update_alpha_s")
	write (unit, "(9A)") "subroutine ", char (name), " (alpha_s) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use tpr_", char (id)
	if (c_default_float == default) then
	write (unit, "(2x,9A)") "real(c_default_float), intent(in) &
	&:: alpha_s"
	write (unit, "(2x,9A)") "call ", char (feature), " (alpha_s)"
	end if
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("is_allowed")
	write (unit, "(9A)") "subroutine ", char (name), &
	" (flv, hel, col, flag) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use tpr_", char (id)
	write (unit, "(2x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(2x,9A)") "logical(c_bool), intent(out) :: flag"
	write (unit, "(2x,9A)") "flag = ", char (feature), &
	" (int (flv), int (hel), int (col))"
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("new_event")
	write (unit, "(9A)") "subroutine ", char (name), " (p) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use tpr_", char (id)
	if (c_default_float == default) then
	write (unit, "(2x,9A)") "real(c_default_float), dimension(0:3,*), &
	&intent(in) :: p"
	write (unit, "(2x,9A)") "call ", char (feature), " (p)"
	end if
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("get_amplitude")
	write (unit, "(9A)") "subroutine ", char (name), &
	" (flv, hel, col, amp) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use tpr_", char (id)
	write (unit, "(2x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(2x,9A)") "complex(c_default_complex), intent(out) &
	&:: amp"
	write (unit, "(2x,9A)") "amp = ", char (feature), &
	" (int (flv), int (hel), int (col))"
	write (unit, "(9A)") "end subroutine ", char (name)
	end select
	end subroutine template_me_write_wrapper

	@ %def template_me_write_wrapper
	@
	\subsection{Driver}
	<<Template matrix elements: public>>=
	public :: template_me_driver_t
	<<Template matrix elements: types>>=
	type, extends (prc_core_driver_t) :: template_me_driver_t
	procedure(init_t), nopass, pointer :: &
	init => null ()
	procedure(update_alpha_s_t), nopass, pointer :: &
	update_alpha_s => null ()
	procedure(is_allowed_t), nopass, pointer :: &
	is_allowed => null ()
	procedure(new_event_t), nopass, pointer :: &
	new_event => null ()
	procedure(get_amplitude_t), nopass, pointer :: &
	get_amplitude => null ()
	contains
	<<Template matrix elements: template ME driver: TBP>>
	end type template_me_driver_t

	@ %def template_me_driver_t
	@ The reported type is the same as for the [[template_me_def_t]] type.
	<<Template matrix elements: template ME driver: TBP>>=
	procedure, nopass :: type_name => template_me_driver_type_name
	<<Template matrix elements: sub interfaces>>=
	module function template_me_driver_type_name () result (string)
	type(string_t) :: string
	end function template_me_driver_type_name
	<<Template matrix elements: procedures>>=
	module function template_me_driver_type_name () result (string)
	type(string_t) :: string
	string = "template"
	end function template_me_driver_type_name

	@ %def template_me_driver_type_name
	@
	\subsection{High-level process definition}
	This procedure wraps the details filling a process-component
	definition entry as appropriate for an template matrix element.
	Gfortran 7/8/9 bug, remains in main module.
	<<Template matrix elements: public>>=
	public :: template_me_make_process_component
	<<Template matrix elements: main procedures>>=
	subroutine template_me_make_process_component (entry, component_index, &
	model, model_name, prt_in, prt_out, unity)
	class(process_def_entry_t), intent(inout) :: entry
	integer, intent(in) :: component_index
	type(string_t), intent(in) :: model_name
	class(model_data_t), intent(in), target :: model
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	logical, intent(in) :: unity
	class(prc_core_def_t), allocatable :: def
	allocate (template_me_def_t :: def)
	select type (def)
	type is (template_me_def_t)
	call def%init (model, prt_in, prt_out, unity)
	end select
	call entry%import_component (component_index, &
	n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("template"), &
	variant = def)
	end subroutine template_me_make_process_component

	@ %def template_me_make_process_component
	@
	\subsection{The [[prc_template_me_t]] wrapper}
	This is an instance of the generic [[prc_core_t]] object. It contains a
	pointer to the process definition ([[template_me_def_t]]), a data component
	([[process_constants_t]]), and the matrix-element driver
	([[template_me_driver_t]]).
	<<Template matrix elements: public>>=
	public :: prc_template_me_t
	<<Template matrix elements: types>>=
	type, extends (prc_core_t) :: prc_template_me_t
	real(default), dimension(:), allocatable :: par
	integer :: scheme = 0
	contains
	<<Template matrix elements: prc template ME: TBP>>
	end type prc_template_me_t

	@ %def prc_template_me_t
	@ The workspace associated to a [[prc_template_me_t]] object contains a single flag.
	The flag is used to suppress re-evaluating the matrix element for each
	quantum-number combination, after the first amplitude belonging to a given
	kinematics has been computed.

	We can also store the value of a running coupling once it has been calculated
	for an event. The default value is negative, which indicates an undefined
	value in this context.
	<<Template matrix elements: types>>=
	type, extends (prc_core_state_t) :: template_me_state_t
	logical :: new_kinematics = .true.
	real(default) :: alpha_qcd = -1
	real(default) :: alpha_qed = -1
	contains
	procedure :: write => template_me_state_write
	procedure :: reset_new_kinematics => template_me_state_reset_new_kinematics
	end type template_me_state_t

	@ %def template_me_state_t
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_state_write (object, unit)
	class(template_me_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine template_me_state_write
	<<Template matrix elements: procedures>>=
	module subroutine template_me_state_write (object, unit)
	class(template_me_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A,L1)") "Template ME state: new kinematics = ", &
	object%new_kinematics
	end subroutine template_me_state_write

	@ %def template_me_state_write
	@
	<<Template matrix elements: sub interfaces>>=
	module subroutine template_me_state_reset_new_kinematics (object)
	class(template_me_state_t), intent(inout) :: object
	end subroutine template_me_state_reset_new_kinematics
	<<Template matrix elements: procedures>>=
	module subroutine template_me_state_reset_new_kinematics (object)
	class(template_me_state_t), intent(inout) :: object
	end subroutine template_me_state_reset_new_kinematics

	@
	@ Allocate the workspace with the above specific type.
	Gfortran 7/8/9 bug, has to remain in the main module.
	<<Template matrix elements: prc template ME: TBP>>=
	procedure :: allocate_workspace => prc_template_me_allocate_workspace
	<<Template matrix elements: main procedures>>=
	subroutine prc_template_me_allocate_workspace (object, core_state)
	class(prc_template_me_t), intent(in) :: object
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	allocate (template_me_state_t :: core_state)
	end subroutine prc_template_me_allocate_workspace

	@ %def prc_template_me_allocate_workspace
	@ The following procedures are inherited from the base type as deferred, thus
	must be implemented. The corresponding unit tests are skipped here; the
	procedures are tested when called from the [[processes]] module.

	Output: print just the ID of the associated matrix element. Then display any
	stored parameters.
	<<Template matrix elements: prc template ME: TBP>>=
	procedure :: write => prc_template_me_write
	<<Template matrix elements: sub interfaces>>=
	module subroutine prc_template_me_write (object, unit)
	class(prc_template_me_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_template_me_write
	<<Template matrix elements: procedures>>=
	module subroutine prc_template_me_write (object, unit)
	class(prc_template_me_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(3x,A)", advance="no") "Template process core:"
	if (object%data_known) then
	write (u, "(1x,A)") char (object%data%id)
	else
	write (u, "(1x,A)") "[undefined]"
	end if
	if (allocated (object%par)) then
	write (u, "(3x,A)") "Parameter array:"
	do i = 1, size (object%par)
	write (u, "(5x,I0,1x,ES17.10)") i, object%par(i)
	end do
	end if
	end subroutine prc_template_me_write

	@ %def prc_template_me_write
	@
	<<Template matrix elements: prc template ME: TBP>>=
	procedure :: write_name => prc_template_me_write_name
	<<Template matrix elements: sub interfaces>>=
	module subroutine prc_template_me_write_name (object, unit)
	class(prc_template_me_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_template_me_write_name
	<<Template matrix elements: procedures>>=
	module subroutine prc_template_me_write_name (object, unit)
	class(prc_template_me_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u,"(1x,A)") "Core: template"
	end subroutine prc_template_me_write_name

	@ %def prc_template_me_write_name
	@ Temporarily store the parameter array inside the [[prc_template_me]]
	object, so we can use it later during the actual initialization.
	<<Template matrix elements: prc template ME: TBP>>=
	procedure :: set_parameters => prc_template_me_set_parameters
	<<Template matrix elements: sub interfaces>>=
	module subroutine prc_template_me_set_parameters (prc_template_me, model)
	class(prc_template_me_t), intent(inout) :: prc_template_me
	class(model_data_t), intent(in), target, optional :: model
	end subroutine prc_template_me_set_parameters
	<<Template matrix elements: procedures>>=
	module subroutine prc_template_me_set_parameters (prc_template_me, model)
	class(prc_template_me_t), intent(inout) :: prc_template_me
	class(model_data_t), intent(in), target, optional :: model
	if (present (model)) then
	if (.not. allocated (prc_template_me%par)) &
	allocate (prc_template_me%par (model%get_n_real ()))
	call model%real_parameters_to_array (prc_template_me%par)
	prc_template_me%scheme = model%get_scheme_num ()
	end if
	end subroutine prc_template_me_set_parameters

	@ %def prc_template_me_set_parameters
	@ To fully initialize the process core, we perform base
	initialization, then initialize the external matrix element code.

	This procedure overrides the [[init]] method of the base type, which
	we nevertheless can access via its binding [[base_init]]. When done, we
	have an allocated driver. The driver will call the [[init]] procedure
	for the external matrix element, and thus transfer the parameter set to
	where it finally belongs.

	<<Template matrix elements: prc template ME: TBP>>=
	procedure :: init => prc_template_me_init
	<<Template matrix elements: sub interfaces>>=
	module subroutine prc_template_me_init (object, def, lib, id, i_component)
	class(prc_template_me_t), intent(inout) :: object
	class(prc_core_def_t), intent(in), target :: def
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	end subroutine prc_template_me_init
	<<Template matrix elements: procedures>>=
	module subroutine prc_template_me_init (object, def, lib, id, i_component)
	class(prc_template_me_t), intent(inout) :: object
	class(prc_core_def_t), intent(in), target :: def
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	call object%base_init (def, lib, id, i_component)
	call object%activate_parameters ()
	end subroutine prc_template_me_init

	@ %def prc_template_me_init
	@ Activate the stored parameters by transferring them to the external
	matrix element.
	<<Template matrix elements: prc template ME: TBP>>=
	procedure :: activate_parameters => prc_template_me_activate_parameters
	<<Template matrix elements: sub interfaces>>=
	module subroutine prc_template_me_activate_parameters (object)
	class (prc_template_me_t), intent(inout) :: object
	end subroutine prc_template_me_activate_parameters
	<<Template matrix elements: procedures>>=
	module subroutine prc_template_me_activate_parameters (object)
	class (prc_template_me_t), intent(inout) :: object
	if (allocated (object%driver)) then
	if (allocated (object%par)) then
	select type (driver => object%driver)
	type is (template_me_driver_t)
	if (associated (driver%init)) then
	call driver%init (object%par, object%scheme)
	end if
	end select
	else
	call msg_bug ("prc_template_me_activate: parameter set is not allocated")
	end if
	else
	call msg_bug ("prc_template_me_activate: driver is not allocated")
	end if
	end subroutine prc_template_me_activate_parameters

	@ %def prc_template_me_activate_parameters
	@ Tell whether a particular combination of flavor, helicity, color is
	allowed. Here we have to consult the matrix-element driver.
	<<Template matrix elements: prc template ME: TBP>>=
	procedure :: is_allowed => prc_template_me_is_allowed
	<<Template matrix elements: sub interfaces>>=
	module function prc_template_me_is_allowed &
	(object, i_term, f, h, c) result (flag)
	class(prc_template_me_t), intent(in) :: object
	integer, intent(in) :: i_term, f, h, c
	logical :: flag
	end function prc_template_me_is_allowed
	<<Template matrix elements: procedures>>=
	module function prc_template_me_is_allowed &
	(object, i_term, f, h, c) result (flag)
	class(prc_template_me_t), intent(in) :: object
	integer, intent(in) :: i_term, f, h, c
	logical :: flag
	logical(c_bool) :: cflag
	select type (driver => object%driver)
	type is (template_me_driver_t)
	call driver%is_allowed (f, h, c, cflag)
	flag = cflag
	end select
	end function prc_template_me_is_allowed

	@ %def prc_template_me_is_allowed
	@ Transfer the generated momenta directly to the hard interaction in
	the (only) term. We assume that everything has been set up correctly,
	so the array fits.

	%We reset the [[new_kinematics]] flag, so that the next call to
	%[[compute_amplitude]] will evaluate the matrix element.
	<<Template matrix elements: prc template ME: TBP>>=
	procedure :: compute_hard_kinematics => &
	prc_template_me_compute_hard_kinematics
	<<Template matrix elements: sub interfaces>>=
	module subroutine prc_template_me_compute_hard_kinematics &
	(object, p_seed, i_term, int_hard, core_state)
	class(prc_template_me_t), intent(in) :: object
	type(vector4_t), dimension(:), intent(in) :: p_seed
	integer, intent(in) :: i_term
	type(interaction_t), intent(inout) :: int_hard
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_template_me_compute_hard_kinematics
	<<Template matrix elements: procedures>>=
	module subroutine prc_template_me_compute_hard_kinematics &
	(object, p_seed, i_term, int_hard, core_state)
	class(prc_template_me_t), intent(in) :: object
	type(vector4_t), dimension(:), intent(in) :: p_seed
	integer, intent(in) :: i_term
	type(interaction_t), intent(inout) :: int_hard
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	call int_hard%set_momenta (p_seed)
	end subroutine prc_template_me_compute_hard_kinematics

	@ %def prc_template_me_compute_hard_kinematics
	@ This procedure is not called for [[prc_template_me_t]], just a placeholder.
	<<Template matrix elements: prc template ME: TBP>>=
	procedure :: compute_eff_kinematics => &
	prc_template_me_compute_eff_kinematics
	<<Template matrix elements: sub interfaces>>=
	module subroutine prc_template_me_compute_eff_kinematics &
	(object, i_term, int_hard, int_eff, core_state)
	class(prc_template_me_t), intent(in) :: object
	integer, intent(in) :: i_term
	type(interaction_t), intent(in) :: int_hard
	type(interaction_t), intent(inout) :: int_eff
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_template_me_compute_eff_kinematics
	<<Template matrix elements: procedures>>=
	module subroutine prc_template_me_compute_eff_kinematics &
	(object, i_term, int_hard, int_eff, core_state)
	class(prc_template_me_t), intent(in) :: object
	integer, intent(in) :: i_term
	type(interaction_t), intent(in) :: int_hard
	type(interaction_t), intent(inout) :: int_eff
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_template_me_compute_eff_kinematics

	@ %def prc_template_me_compute_eff_kinematics
	@ Compute the amplitude. For the tree-level process, we can ignore the scale
	settings. The term index [[j]] is also irrelevant.

	We first call [[new_event]] for the given momenta (which we must unpack), then
	retrieve the amplitude value for the given quantum numbers.

	If the [[core_state]] status flag is present, we can make sure that we call
	[[new_event]] only once for a given kinematics. After the first call, we
	unset the [[new_kinematics]] flag.
	<<Template matrix elements: prc template ME: TBP>>=
	procedure :: compute_amplitude => prc_template_me_compute_amplitude
	<<Template matrix elements: sub interfaces>>=
	module function prc_template_me_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(prc_template_me_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: &
	core_state
	complex(default) :: amp
	end function prc_template_me_compute_amplitude
	<<Template matrix elements: procedures>>=
	module function prc_template_me_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(prc_template_me_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: core_state
	complex(default) :: amp
	integer :: n_tot, i
	real(c_default_float), dimension(:,:), allocatable :: parray
	complex(c_default_complex) :: camp
	logical :: new_event
	select type (driver => object%driver)
	type is (template_me_driver_t)
	new_event = .true.
	if (present (core_state)) then
	if (allocated (core_state)) then
	select type (core_state)
	type is (template_me_state_t)
	new_event = core_state%new_kinematics
	core_state%new_kinematics = .false.
	end select
	end if
	end if
	if (new_event) then
	n_tot = object%data%n_in + object%data%n_out
	allocate (parray (0:3, n_tot))
	forall (i = 1:n_tot) parray(:,i) = vector4_get_components (p(i))
	call driver%new_event (parray)
	end if
	if (object%is_allowed (1, f, h, c)) then
	call driver%get_amplitude &
	(int (f, c_int), int (h, c_int), int (c, c_int), camp)
	amp = camp
	else
	amp = 0
	end if
	end select
	end function prc_template_me_compute_amplitude

	@ %def prc_template_me_compute_amplitude
	@ We do not overwrite the [[prc_core_t]] routine for $\alpha_s$.

	\subsection{Unit Test}
	Test module, followed by the corresponding implementation module.
	<<[[prc_template_me_ut.f90]]>>=
	<<File header>>

	module prc_template_me_ut
	use unit_tests
	use prc_template_me_uti

	<<Standard module head>>

	<<Template matrix elements: public test>>

	contains

	<<Template matrix elements: test driver>>

	end module prc_template_me_ut
	@ %def prc_template_me_ut
	@
	<<[[prc_template_me_uti.f90]]>>=
	<<File header>>

	module prc_template_me_uti

	use, intrinsic :: iso_c_binding !NODEP!

	use kinds
	<<Use strings>>
	use os_interface
	use particle_specifiers, only: new_prt_spec
	use model_data
	use prc_core_def
	use process_constants
	use process_libraries
	use model_testbed, only: prepare_model, cleanup_model

	use prc_template_me

	<<Standard module head>>

	<<Template matrix elements: test declarations>>

	contains

	<<Template matrix elements: tests>>

	end module prc_template_me_uti
	@ %def prc_template_me_ut
	@ API: driver for the unit tests below.
	<<Template matrix elements: public test>>=
	public :: prc_template_me_test
	<<Template matrix elements: test driver>>=
	subroutine prc_template_me_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Template matrix elements: execute tests>>
	end subroutine prc_template_me_test

	@ %def prc_template_me_test
	@
	\subsubsection{Generate, compile and load a simple process matrix element}
	The process is $e^+ e^- \to \mu^+\mu^-$ for vanishing masses and
	$e=0.3$. We initialize the process, build the library, and compute a
	particular matrix element for momenta of unit energy and right-angle
	scattering. The matrix element, as it happens, is equal to $e^2$.
	(Note that are no conversion factors applied, so this result is
	exact.)

	For [[GNU make]], [[makeflags]] is set to [[-j1]]. This eliminates a
	potential clash with a [[-j<n>]] flag if this test is called from a
	parallel make.
	<<Template matrix elements: execute tests>>=
	call test (prc_template_me_1, "prc_template_me_1", &
	"build and load simple template process", &
	u, results)
	<<Template matrix elements: test declarations>>=
	public :: prc_template_me_1
	<<Template matrix elements: tests>>=
	subroutine prc_template_me_1 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(string_t) :: model_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(process_constants_t) :: data
	class(prc_core_driver_t), allocatable :: driver
	integer, parameter :: cdf = c_default_float
	integer, parameter :: ci = c_int
	real(cdf), dimension(4) :: par
	real(cdf), dimension(0:3,4) :: p
	logical(c_bool) :: flag
	complex(c_default_complex) :: amp
	integer :: i

	write (u, "(A)") "* Test output: prc_template_me_1"
	write (u, "(A)") "* Purpose: create a template matrix element,"
	write (u, "(A)") "* normalized to give unit integral,"
	write (u, "(A)") "* build a library, link, load, and &
	&access the matrix element"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry"
	write (u, "(A)")
	call lib%init (var_str ("template_me1"))
	call os_data%init ()

	model_name = "QED"
	model => null ()
	call prepare_model (model, model_name)

	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("m+"), var_str ("m-")]

	allocate (template_me_def_t :: def)
	select type (def)
	type is (template_me_def_t)
	call def%init (model, prt_in, prt_out, unity = .false.)
	end select
	allocate (entry)
	call entry%init (var_str ("template_me1_a"), model_name = model_name, &
	n_in = 2, n_components = 1)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("template"), &
	variant = def)
	call lib%append (entry)

	write (u, "(A)") "* Configure library"
	write (u, "(A)")
	call lib%configure (os_data)

	write (u, "(A)") "* Write makefile"
	write (u, "(A)")
	call lib%write_makefile (os_data, force = .true., verbose = .false.)

	write (u, "(A)") "* Clean any left-over files"
	write (u, "(A)")
	call lib%clean (os_data, distclean = .false.)

	write (u, "(A)") "* Write driver"
	write (u, "(A)")
	call lib%write_driver (force = .true.)

	write (u, "(A)") "* Write process source code, compile, link, load"
	write (u, "(A)")
	call lib%load (os_data)

	call lib%write (u, libpath = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Probe library API:"
	write (u, "(A)")

	write (u, "(1x,A,L1)") "is active = ", &
	lib%is_active ()
	write (u, "(1x,A,I0)") "n_processes = ", &
	lib%get_n_processes ()

	write (u, "(A)")
	write (u, "(A)") "* Constants of template_me1_a_i1:"
	write (u, "(A)")

	call lib%connect_process (var_str ("template_me1_a"), 1, data, driver)

	write (u, "(1x,A,A)") "component ID = ", char (data%id)
	write (u, "(1x,A,A)") "model name = ", char (data%model_name)
	write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
	write (u, "(1x,A,I0)") "n_in = ", data%n_in
	write (u, "(1x,A,I0)") "n_out = ", data%n_out
	write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
	write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
	write (u, "(1x,A,I0)") "n_col = ", data%n_col
	write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
	write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
	write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
	write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,1)
	do i = 2, 16
	write (u, "(12x,4(1x,I2))") data%hel_state(:,i)
	end do
	write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
	write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
	write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
	write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index

	write (u, "(A)")
	write (u, "(A)") "* Set parameters for template_me1_a and initialize:"
	write (u, "(A)")

	par = [0.3_cdf, 0.0_cdf, 0.0_cdf, 0.0_cdf]
	write (u, "(2x,A,F6.4)") "ee = ", par(1)
	write (u, "(2x,A,F6.4)") "me = ", par(2)
	write (u, "(2x,A,F6.4)") "mmu = ", par(3)
	write (u, "(2x,A,F6.4)") "mtau = ", par(4)

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics:"
	write (u, "(A)")

	p = reshape ([ &
	1.0_cdf, 0.0_cdf, 0.0_cdf, 1.0_cdf, &
	1.0_cdf, 0.0_cdf, 0.0_cdf,-1.0_cdf, &
	1.0_cdf, 1.0_cdf, 0.0_cdf, 0.0_cdf, &
	1.0_cdf,-1.0_cdf, 0.0_cdf, 0.0_cdf &
	], [4,4])
	do i = 1, 4
	write (u, "(2x,A,I0,A,4(1x,F7.4))") "p", i, " =", p(:,i)
	end do

	select type (driver)
	type is (template_me_driver_t)
	call driver%init (par, 0)

	call driver%new_event (p)

	write (u, "(A)")
	write (u, "(A)") "* Compute matrix element:"
	write (u, "(A)")

	call driver%is_allowed (1_ci, 6_ci, 1_ci, flag)
	write (u, "(1x,A,L1)") "is_allowed (1, 6, 1) = ", flag

	call driver%get_amplitude (1_ci, 6_ci, 1_ci, amp)
	write (u, "(1x,A,1x,E11.4)") "\|amp (1, 6, 1)\| =", abs (amp)
	end select

	call lib%final ()
	call cleanup_model (model)
	deallocate (model)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: prc_template_me_1"

	end subroutine prc_template_me_1

	@ %def prc_template_me_1
	@
	<<Template matrix elements: execute tests>>=
	call test (prc_template_me_2, "prc_template_me_2", &
	"build and load simple template_unity process", &
	u, results)
	<<Template matrix elements: test declarations>>=
	public :: prc_template_me_2
	<<Template matrix elements: tests>>=
	subroutine prc_template_me_2 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(string_t) :: model_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(process_constants_t) :: data
	class(prc_core_driver_t), allocatable :: driver
	integer, parameter :: cdf = c_default_float
	integer, parameter :: ci = c_int
	real(cdf), dimension(4) :: par
	real(cdf), dimension(0:3,4) :: p
	logical(c_bool) :: flag
	complex(c_default_complex) :: amp
	integer :: i

	write (u, "(A)") "* Test output: prc_template_me_1"
	write (u, "(A)") "* Purpose: create a template matrix element,"
	write (u, "(A)") "* being identical to unity,"
	write (u, "(A)") "* build a library, link, load, and &
	&access the matrix element"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry"
	write (u, "(A)")
	call lib%init (var_str ("template_me2"))
	call os_data%init ()

	model_name = "QED"
	model => null ()
	call prepare_model (model, model_name)

	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("m+"), var_str ("m-")]

	allocate (template_me_def_t :: def)
	select type (def)
	type is (template_me_def_t)
	call def%init (model, prt_in, prt_out, unity = .true.)
	end select
	allocate (entry)
	call entry%init (var_str ("template_me2_a"), model_name = model_name, &
	n_in = 2, n_components = 1)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("template_unity"), &
	variant = def)
	call lib%append (entry)

	write (u, "(A)") "* Configure library"
	write (u, "(A)")
	call lib%configure (os_data)

	write (u, "(A)") "* Write makefile"
	write (u, "(A)")
	call lib%write_makefile (os_data, force = .true., verbose = .false.)

	write (u, "(A)") "* Clean any left-over files"
	write (u, "(A)")
	call lib%clean (os_data, distclean = .false.)

	write (u, "(A)") "* Write driver"
	write (u, "(A)")
	call lib%write_driver (force = .true.)

	write (u, "(A)") "* Write process source code, compile, link, load"
	write (u, "(A)")
	call lib%load (os_data)

	call lib%write (u, libpath = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Probe library API:"
	write (u, "(A)")

	write (u, "(1x,A,L1)") "is active = ", &
	lib%is_active ()
	write (u, "(1x,A,I0)") "n_processes = ", &
	lib%get_n_processes ()

	write (u, "(A)")
	write (u, "(A)") "* Constants of template_me2_a_i1:"
	write (u, "(A)")

	call lib%connect_process (var_str ("template_me2_a"), 1, data, driver)

	write (u, "(1x,A,A)") "component ID = ", char (data%id)
	write (u, "(1x,A,A)") "model name = ", char (data%model_name)
	write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
	write (u, "(1x,A,I0)") "n_in = ", data%n_in
	write (u, "(1x,A,I0)") "n_out = ", data%n_out
	write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
	write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
	write (u, "(1x,A,I0)") "n_col = ", data%n_col
	write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
	write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
	write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
	write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,1)
	do i = 2, 16
	write (u, "(12x,4(1x,I2))") data%hel_state(:,i)
	end do
	write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
	write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
	write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
	write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index

	write (u, "(A)")
	write (u, "(A)") "* Set parameters for template_me2_a and initialize:"
	write (u, "(A)")

	par = [0.3_cdf, 0.0_cdf, 0.0_cdf, 0.0_cdf]
	write (u, "(2x,A,F6.4)") "ee = ", par(1)
	write (u, "(2x,A,F6.4)") "me = ", par(2)
	write (u, "(2x,A,F6.4)") "mmu = ", par(3)
	write (u, "(2x,A,F6.4)") "mtau = ", par(4)

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics:"
	write (u, "(A)")

	p = reshape ([ &
	1.0_cdf, 0.0_cdf, 0.0_cdf, 1.0_cdf, &
	1.0_cdf, 0.0_cdf, 0.0_cdf,-1.0_cdf, &
	1.0_cdf, 1.0_cdf, 0.0_cdf, 0.0_cdf, &
	1.0_cdf,-1.0_cdf, 0.0_cdf, 0.0_cdf &
	], [4,4])
	do i = 1, 4
	write (u, "(2x,A,I0,A,4(1x,F7.4))") "p", i, " =", p(:,i)
	end do

	select type (driver)
	type is (template_me_driver_t)
	call driver%init (par, 0)

	call driver%new_event (p)

	write (u, "(A)")
	write (u, "(A)") "* Compute matrix element:"
	write (u, "(A)")

	call driver%is_allowed (1_ci, 6_ci, 1_ci, flag)
	write (u, "(1x,A,L1)") "is_allowed (1, 6, 1) = ", flag

	call driver%get_amplitude (1_ci, 6_ci, 1_ci, amp)
	write (u, "(1x,A,1x,E11.4)") "\|amp (1, 6, 1)\| =", abs (amp)
	end select

	call lib%final ()
	call cleanup_model (model)
	deallocate (model)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: prc_template_me_2"

	end subroutine prc_template_me_2

	@ %def prc_template_me_2
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{\oMega\ Interface}

	The standard method for process computation with \whizard\ is the
	\oMega\ matrix element generator.

	This section implements the interface to the code generator (via
	the makefile) and the driver for the features provided by the \oMega\
	matrix element.

	There are actually two different methods steered by this interface, the
	traditional one which delivers compiled Fortran code, while the \oMega\
	virtual machine (OVM) produces bytecode with look-up tables.
	<<[[prc_omega.f90]]>>=
	<<File header>>

	module prc_omega

	use, intrinsic :: iso_c_binding !NODEP!

	use kinds
	<<Use strings>>
	use constants, only: one
	use os_interface
	use diagnostics
	use lorentz
	use sm_qcd
	use sm_qed
	use interactions
	use model_data

	use particle_specifiers, only: new_prt_spec
	use process_constants
	use prclib_interfaces
	use prc_core_def
	use process_libraries
	use prc_core

	<<Standard module head>>

	<<Omega interface: public>>

	<<Omega interface: types>>

	<<Omega interface: interfaces>>

	interface
	<<Omega interface: sub interfaces>>
	end interface

	contains

	<<Omega interface: main procedures>>

	end module prc_omega
	@ %def prc_omega
	@
	<<[[prc_omega_sub.f90]]>>=
	<<File header>>

	submodule (prc_omega) prc_omega_s

	use io_units
	use system_defs, only: TAB

	implicit none

	contains

	<<Omega interface: procedures>>

	end submodule prc_omega_s

	@ %def prc_omega_s
	@
	\subsection{Process definition}
	For the process definition we implement an extension of the
	[[prc_core_def_t]] abstract type.
	<<Omega interface: public>>=
	public :: omega_def_t
	<<Omega interface: types>>=
	type, extends (prc_core_def_t) :: omega_def_t
	logical :: ufo = .false.
	logical :: ovm = .false.
	contains
	<<Omega interface: omega def: TBP>>
	end type omega_def_t

	@ %def omega_def_t
	@
	<<Omega interface: omega def: TBP>>=
	procedure, nopass :: type_string => omega_def_type_string
	<<Omega interface: sub interfaces>>=
	module function omega_def_type_string () result (string)
	type(string_t) :: string
	end function omega_def_type_string
	<<Omega interface: procedures>>=
	module function omega_def_type_string () result (string)
	type(string_t) :: string
	string = "omega"
	end function omega_def_type_string

	@ %def omega_omega_def_type_string
	@
	Initialization: allocate the writer for the \oMega\ matrix element.
	The writer type depends on the settings of the [[ufo]] and [[ovm]] flags.
	Also set any data for this process that the writer needs.
	Gfortran 7/8/9 bug, has to remain in the main module.
	<<Omega interface: omega def: TBP>>=
	procedure :: init => omega_def_init
	<<Omega interface: main procedures>>=
	subroutine omega_def_init (object, &
	model_name, prt_in, prt_out, &
	ovm, ufo, ufo_path, &
	restrictions, cms_scheme, &
	openmp_support, report_progress, write_phs_output, extra_options, diags, diags_color)
	class(omega_def_t), intent(out) :: object
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	logical, intent(in) :: ovm
	logical, intent(in) :: ufo
	type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	logical, intent(in), optional :: cms_scheme
	logical, intent(in), optional :: openmp_support
	logical, intent(in), optional :: report_progress
	logical, intent(in), optional :: write_phs_output
	type(string_t), intent(in), optional :: extra_options
	logical, intent(in), optional :: diags, diags_color
	object%ufo = ufo
	object%ovm = ovm
	if (object%ufo) then
	if (object%ovm) then
	call msg_fatal ("Omega process: OVM method does not support UFO model")
	else
	allocate (omega_ufo_writer_t :: object%writer)
	end if
	else
	if (object%ovm) then
	allocate (omega_ovm_writer_t :: object%writer)
	else
	allocate (omega_omega_writer_t :: object%writer)
	end if
	end if
	select type (writer => object%writer)
	class is (omega_writer_t)
	call writer%init (model_name, prt_in, prt_out, &
	ufo_path, restrictions, cms_scheme, &
	openmp_support, report_progress, write_phs_output, extra_options, diags, diags_color)
	end select
	end subroutine omega_def_init

	@ %def omega_def_init
	@ Write/read process- and method-specific data.
	<<Omega interface: omega def: TBP>>=
	procedure :: write => omega_def_write
	<<Omega interface: sub interfaces>>=
	module subroutine omega_def_write (object, unit)
	class(omega_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine omega_def_write
	<<Omega interface: procedures>>=
	module subroutine omega_def_write (object, unit)
	class(omega_def_t), intent(in) :: object
	integer, intent(in) :: unit
	select type (writer => object%writer)
	class is (omega_writer_t)
	call writer%write (unit)
	end select
	end subroutine omega_def_write

	@ %def omega_def_write
	@
	<<Omega interface: omega def: TBP>>=
	procedure :: read => omega_def_read
	<<Omega interface: sub interfaces>>=
	module subroutine omega_def_read (object, unit)
	class(omega_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine omega_def_read
	<<Omega interface: procedures>>=
	module subroutine omega_def_read (object, unit)
	class(omega_def_t), intent(out) :: object
	integer, intent(in) :: unit
	call msg_bug ("O'Mega process definition: input not supported yet")
	end subroutine omega_def_read

	@ %def omega_def_read
	@ Allocate the driver for \oMega matrix elements.
	Gfortran 7/8/9 bug, has to remain in the main module.
	<<Omega interface: omega def: TBP>>=
	procedure :: allocate_driver => omega_def_allocate_driver
	<<Omega interface: main procedures>>=
	subroutine omega_def_allocate_driver (object, driver, basename)
	class(omega_def_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	allocate (omega_driver_t :: driver)
	end subroutine omega_def_allocate_driver

	@ %def omega_def_allocate_driver
	@ We need code:
	<<Omega interface: omega def: TBP>>=
	procedure, nopass :: needs_code => omega_def_needs_code
	<<Omega interface: sub interfaces>>=
	module function omega_def_needs_code () result (flag)
	logical :: flag
	end function omega_def_needs_code
	<<Omega interface: procedures>>=
	module function omega_def_needs_code () result (flag)
	logical :: flag
	flag = .true.
	end function omega_def_needs_code

	@ %def omega_def_needs_code
	@ These are the features that an \oMega\ matrix element provides.
	<<Omega interface: omega def: TBP>>=
	procedure, nopass :: get_features => omega_def_get_features
	<<Omega interface: sub interfaces>>=
	module subroutine omega_def_get_features (features)
	type(string_t), dimension(:), allocatable, intent(out) :: features
	end subroutine omega_def_get_features
	<<Omega interface: procedures>>=
	module subroutine omega_def_get_features (features)
	type(string_t), dimension(:), allocatable, intent(out) :: features
	allocate (features (6))
	features = [ &
	var_str ("init"), &
	var_str ("update_alpha_s"), &
	var_str ("reset_helicity_selection"), &
	var_str ("is_allowed"), &
	var_str ("new_event"), &
	var_str ("get_amplitude")]
	end subroutine omega_def_get_features

	@ %def omega_def_get_features
	@ The interface of the specific features.
	<<Omega interface: interfaces>>=
	abstract interface
	subroutine init_t (par, scheme) bind(C)
	import
	real(c_default_float), dimension(*), intent(in) :: par
	integer(c_int), intent(in) :: scheme
	end subroutine init_t
	end interface

	abstract interface
	subroutine update_alpha_s_t (alpha_s) bind(C)
	import
	real(c_default_float), intent(in) :: alpha_s
	end subroutine update_alpha_s_t
	end interface

	abstract interface
	subroutine reset_helicity_selection_t (threshold, cutoff) bind(C)
	import
	real(c_default_float), intent(in) :: threshold
	integer(c_int), intent(in) :: cutoff
	end subroutine reset_helicity_selection_t
	end interface

	abstract interface
	subroutine is_allowed_t (flv, hel, col, flag) bind(C)
	import
	integer(c_int), intent(in) :: flv, hel, col
	logical(c_bool), intent(out) :: flag
	end subroutine is_allowed_t
	end interface

	abstract interface
	subroutine new_event_t (p) bind(C)
	import
	real(c_default_float), dimension(0:3,*), intent(in) :: p
	end subroutine new_event_t
	end interface

	abstract interface
	subroutine get_amplitude_t (flv, hel, col, amp) bind(C)
	import
	integer(c_int), intent(in) :: flv, hel, col
	complex(c_default_complex), intent(out):: amp
	end subroutine get_amplitude_t
	end interface

	@ %def init_t update_alpha_s_t reset_helicity_selection_t
	@ %def is_allowed_t new_event_t get_amplitude_t
	@ Connect the \oMega\ features with the process driver.
	<<Omega interface: omega def: TBP>>=
	procedure :: connect => omega_def_connect
	<<Omega interface: sub interfaces>>=
	module subroutine omega_def_connect (def, lib_driver, i, proc_driver)
	class(omega_def_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	end subroutine omega_def_connect
	<<Omega interface: procedures>>=
	module subroutine omega_def_connect (def, lib_driver, i, proc_driver)
	class(omega_def_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	integer(c_int) :: pid, fid
	type(c_funptr) :: fptr
	select type (proc_driver)
	type is (omega_driver_t)
	pid = i
	fid = 1
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%init)
	fid = 2
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%update_alpha_s)
	fid = 3
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%reset_helicity_selection)
	fid = 4
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%is_allowed)
	fid = 5
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%new_event)
	fid = 6
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%get_amplitude)
	end select
	end subroutine omega_def_connect

	@ %def omega_def_connect
	@
	\subsection{The \oMega\ writer}
	The \oMega\ writer is responsible for inserting the appropriate lines
	in the makefile that call \oMega, and for writing interfaces and
	wrappers.
	<<Omega interface: types>>=
	type, extends (prc_writer_f_module_t), abstract :: omega_writer_t
	type(string_t) :: model_name
	type(string_t) :: process_mode
	type(string_t) :: process_string
	type(string_t) :: restrictions
	logical :: openmp_support = .false.
	logical :: report_progress = .false.
	logical :: diags = .false.
	logical :: diags_color = .false.
	logical :: complex_mass_scheme = .false.
	logical :: write_phs_output = .false.
	type(string_t) :: extra_options
	contains
	<<Omega interface: omega writer: TBP>>
	end type omega_writer_t

	@ %def omega_writer_t
	@
	<<Omega interface: types>>=
	type, extends (omega_writer_t) :: omega_omega_writer_t
	contains
	<<Omega interface: omega omega writer: TBP>>
	end type omega_omega_writer_t

	@ %def omega_omega_writer_t
	@
	<<Omega interface: types>>=
	type, extends (omega_omega_writer_t) :: omega_ufo_writer_t
	type(string_t) :: ufo_path
	contains
	<<Omega interface: omega ufo writer: TBP>>
	end type omega_ufo_writer_t

	@ %def omega_ufo_writer_t
	@
	<<Omega interface: types>>=
	type, extends (omega_writer_t) :: omega_ovm_writer_t
	contains
	<<Omega interface: omega ovm writer: TBP>>
	end type omega_ovm_writer_t

	@ %def omega_ovm_writer_t
	@
	<<Omega interface: omega omega writer: TBP>>=
	procedure, nopass :: type_name => omega_omega_writer_type_name
	<<Omega interface: sub interfaces>>=
	module function omega_omega_writer_type_name () result (string)
	type(string_t) :: string
	end function omega_omega_writer_type_name
	<<Omega interface: procedures>>=
	module function omega_omega_writer_type_name () result (string)
	type(string_t) :: string
	string = "omega"
	end function omega_omega_writer_type_name

	@ %def omega_omega_writer_type_name
	@
	<<Omega interface: omega ufo writer: TBP>>=
	procedure, nopass :: type_name => omega_ufo_writer_type_name
	<<Omega interface: sub interfaces>>=
	module function omega_ufo_writer_type_name () result (string)
	type(string_t) :: string
	end function omega_ufo_writer_type_name
	<<Omega interface: procedures>>=
	module function omega_ufo_writer_type_name () result (string)
	type(string_t) :: string
	string = "omega/UFO"
	end function omega_ufo_writer_type_name

	@ %def omega_ufo_writer_type_name
	@
	<<Omega interface: omega ovm writer: TBP>>=
	procedure, nopass :: type_name => omega_ovm_writer_type_name
	<<Omega interface: sub interfaces>>=
	module function omega_ovm_writer_type_name () result (string)
	type(string_t) :: string
	end function omega_ovm_writer_type_name
	<<Omega interface: procedures>>=
	module function omega_ovm_writer_type_name () result (string)
	type(string_t) :: string
	string = "ovm"
	end function omega_ovm_writer_type_name

	@ %def omega_ovm_writer_type_name
	@
	@ Taking into account the prefix for \oMega\ module names.
	<<Omega interface: omega writer: TBP>>=
	procedure, nopass :: get_module_name => omega_writer_get_module_name
	<<Omega interface: sub interfaces>>=
	module function omega_writer_get_module_name (id) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: id
	end function omega_writer_get_module_name
	<<Omega interface: procedures>>=
	module function omega_writer_get_module_name (id) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: id
	name = "opr_" // id
	end function omega_writer_get_module_name

	@ %def omega_writer_get_module_name
	@ Output. This is called by [[omega_def_write]].
	<<Omega interface: omega writer: TBP>>=
	procedure :: write => omega_writer_write
	<<Omega interface: sub interfaces>>=
	module subroutine omega_writer_write (object, unit)
	class(omega_writer_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine omega_writer_write
	<<Omega interface: procedures>>=
	module subroutine omega_writer_write (object, unit)
	class(omega_writer_t), intent(in) :: object
	integer, intent(in) :: unit
	write (unit, "(5x,A,A)") "Model name = ", &
	'"' // char (object%model_name) // '"'
	write (unit, "(5x,A,A)") "Mode string = ", &
	'"' // char (object%process_mode) // '"'
	write (unit, "(5x,A,A)") "Process string = ", &
	'"' // char (object%process_string) // '"'
	write (unit, "(5x,A,A)") "Restrictions = ", &
	'"' // char (object%restrictions) // '"'
	write (unit, "(5x,A,L1)") "OpenMP support = ", object%openmp_support
	write (unit, "(5x,A,L1)") "Report progress = ", object%report_progress
	! write (unit, "(5x,A,L1)") "Write phs output = ", object%write_phs_output
	write (unit, "(5x,A,A)") "Extra options = ", &
	'"' // char (object%extra_options) // '"'
	write (unit, "(5x,A,L1)") "Write diagrams = ", object%diags
	write (unit, "(5x,A,L1)") "Write color diag. = ", object%diags_color
	write (unit, "(5x,A,L1)") "Complex Mass S. = ", &
	object%complex_mass_scheme
	end subroutine omega_writer_write

	@ %def omega_writer_write
	@ Initialize with process data.
	<<Omega interface: omega writer: TBP>>=
	procedure :: init => omega_writer_init
	<<Omega interface: sub interfaces>>=
	module subroutine omega_writer_init (writer, model_name, prt_in, prt_out, &
	ufo_path, restrictions, cms_scheme, openmp_support, &
	report_progress, write_phs_output, extra_options, diags, diags_color)
	class(omega_writer_t), intent(out) :: writer
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	logical, intent(in), optional :: cms_scheme
	logical, intent(in), optional :: openmp_support
	logical, intent(in), optional :: report_progress
	logical, intent(in), optional :: write_phs_output
	type(string_t), intent(in), optional :: extra_options
	logical, intent(in), optional :: diags, diags_color
	end subroutine omega_writer_init
	<<Omega interface: procedures>>=
	module subroutine omega_writer_init (writer, model_name, prt_in, prt_out, &
	ufo_path, restrictions, cms_scheme, openmp_support, &
	report_progress, write_phs_output, extra_options, diags, diags_color)
	class(omega_writer_t), intent(out) :: writer
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	logical, intent(in), optional :: cms_scheme
	logical, intent(in), optional :: openmp_support
	logical, intent(in), optional :: report_progress
	logical, intent(in), optional :: write_phs_output
	type(string_t), intent(in), optional :: extra_options
	logical, intent(in), optional :: diags, diags_color
	integer :: i
	writer%model_name = model_name
	select type (writer)
	type is (omega_ufo_writer_t)
	if (present (ufo_path)) then
	writer%ufo_path = ufo_path
	else
	call msg_fatal ("O'Mega: UFO model option is selected, but UFO model path is unset")
	end if
	end select
	if (present (restrictions)) then
	writer%restrictions = restrictions
	else
	writer%restrictions = ""
	end if
	if (present (cms_scheme)) writer%complex_mass_scheme = cms_scheme
	if (present (openmp_support)) writer%openmp_support = openmp_support
	if (present (report_progress)) writer%report_progress = report_progress
	if (present (write_phs_output)) writer%write_phs_output = write_phs_output
	if (present (extra_options)) then
	writer%extra_options = " " // extra_options
	else
	writer%extra_options = ""
	end if
	if (present (diags)) writer%diags = diags
	if (present (diags_color)) writer%diags_color = diags_color
	select case (size (prt_in))
	case (1); writer%process_mode = " -decay"
	case (2); writer%process_mode = " -scatter"
	end select
	associate (s => writer%process_string)
	s = " '"
	do i = 1, size (prt_in)
	if (i > 1) s = s // " "
	s = s // prt_in(i)
	end do
	s = s // " ->"
	do i = 1, size (prt_out)
	s = s // " " // prt_out(i)
	end do
	s = s // "'"
	end associate
	end subroutine omega_writer_init

	@ %def omega_writer_init
	@ The makefile implements the actual \oMega\ call. For old \LaTeX\
	distributions, we filter out the hyperref options for \oMega\
	diagrams, at least in the testsuite.
	<<Omega interface: omega writer: TBP>>=
	procedure :: write_makefile_code => omega_write_makefile_code
	<<Omega interface: sub interfaces>>=
	module subroutine omega_write_makefile_code &
	(writer, unit, id, os_data, verbose, testflag)
	class(omega_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	end subroutine omega_write_makefile_code
	<<Omega interface: procedures>>=
	module subroutine omega_write_makefile_code &
	(writer, unit, id, os_data, verbose, testflag)
	class(omega_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	type(string_t) :: omega_binary, omega_path
	type(string_t) :: restrictions_string
	type(string_t) :: openmp_string
	type(string_t) :: kmatrix_string
	type(string_t) :: progress_string
	type(string_t) :: diagrams_string
	type(string_t) :: cms_string
	type(string_t) :: write_phs_output_string
	type(string_t) :: parameter_module
	logical :: escape_hyperref
	escape_hyperref = .false.
	if (present (testflag)) escape_hyperref = testflag
	select type (writer)
	type is (omega_omega_writer_t)
	omega_binary = "omega_" // writer%model_name // ".opt"
	type is (omega_ufo_writer_t)
	omega_binary = "omega_UFO.opt"
	type is (omega_ovm_writer_t)
	select case (char (writer%model_name))
	case ("SM", "SM_CKM", "SM_Higgs", "THDM", "THDM_CKM", &
	"HSExt", "QED", "QCD", "Zprime")
	case default
	call msg_fatal ("The model " // char (writer%model_name) &
	// " is not available for the O'Mega VM.")
	end select
	omega_binary = "omega_" // writer%model_name // "_VM.opt"
	end select
	omega_path = os_data%whizard_omega_binpath // "/" // omega_binary
	if (.not. verbose) omega_path = "@" // omega_path
	if (writer%restrictions /= "") then
	restrictions_string = " -cascade '" // writer%restrictions // "'"
	else
	restrictions_string = ""
	end if
	if (writer%openmp_support) then
	openmp_string = " -target:openmp"
	else
	openmp_string = ""
	end if
	if (writer%report_progress) then
	progress_string = " -fusion:progress"
	else
	progress_string = ""
	end if
	if (writer%diags) then
	if (writer%diags_color) then
	diagrams_string = " -diagrams:C " // char(id) // &
	"_diags -diagrams_LaTeX"
	else
	diagrams_string = " -diagrams " // char(id) // &
	"_diags -diagrams_LaTeX"
	end if
	else
	if (writer%diags_color) then
	diagrams_string = " -diagrams:c " // char(id) // &
	"_diags -diagrams_LaTeX"
	else
	diagrams_string = ""
	end if
	end if
	if (writer%complex_mass_scheme) then
	cms_string = " -model:cms_width"
	else
	cms_string = ""
	end if
	if (writer%write_phs_output) then
	write_phs_output_string = " -phase_space " // char (id) // ".fds"
	else
	write_phs_output_string = ""
	endif
	select case (char (writer%model_name))
	case ("SM_rx", "SSC", "NoH_rx", "AltH")
	kmatrix_string = " -target:kmatrix_2_write"
	case ("SSC_2", "SSC_AltT", "SM_ul")
	kmatrix_string = " -target:kmatrix_write"
	case default
	kmatrix_string = ""
	end select
	write (unit, "(5A)") "SOURCES += ", char (id), ".f90"
	select type (writer)
	type is (omega_ovm_writer_t)
	write (unit, "(5A)") "SOURCES += ", char (id), ".hbc"
	end select
	if (writer%diags .or. writer%diags_color) then
	write (unit, "(5A)") "TEX_SOURCES += ", char (id), "_diags.tex"
	if (os_data%event_analysis_pdf) then
	write (unit, "(5A)") "TEX_OBJECTS += ", char (id), "_diags.pdf"
	else
	write (unit, "(5A)") "TEX_OBJECTS += ", char (id), "_diags.ps"
	end if
	end if
	write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
	select type (writer)
	type is (omega_omega_writer_t)
	write (unit, "(5A)") char (id), ".f90:"
	if (.not. verbose) then
	write (unit, "(5A)") TAB // '@echo " OMEGA ', trim (char (id)), '.f90"'
	end if
	write (unit, "(99A)") TAB, char (omega_path), &
	" -o ", char (id), ".f90", &
	" -target:whizard", &
	" -target:parameter_module parameters_", char (writer%model_name), &
	" -target:module opr_", char (id), &
	" -target:md5sum '", writer%md5sum, "'", &
	char (cms_string), &
	char (openmp_string), &
	char (progress_string), &
	char (kmatrix_string), &
	char (writer%process_mode), char (writer%process_string), &
	char (restrictions_string), char (diagrams_string), &
	char (writer%extra_options), char (write_phs_output_string)
	type is (omega_ufo_writer_t)
	parameter_module = char (id) // "_par_" // replace (char (writer%model_name), &
	"-", "_", every=.true.)
	write (unit, "(5A)") char (id), ".f90: ", char (parameter_module), ".lo"
	if (.not. verbose) then
	write (unit, "(5A)") TAB // '@echo " OMEGA[UFO]', trim (char (id)), '.f90"'
	end if
	write (unit, "(99A)") TAB, char (omega_path), &
	" -o ", char (id), ".f90", &
	" -model:UFO_dir ", &
	char (writer%ufo_path), "/", char (writer%model_name), &
	" -model:exec", &
	" -target:whizard", &
	" -target:parameter_module ", char (parameter_module), &
	" -target:module opr_", char (id), &
	" -target:md5sum '", writer%md5sum, "'", &
	char (cms_string), &
	char (openmp_string), &
	char (progress_string), &
	char (kmatrix_string), &
	char (writer%process_mode), char (writer%process_string), &
	char (restrictions_string), char (diagrams_string), &
	char (writer%extra_options), char (write_phs_output_string)
	write (unit, "(5A)") "SOURCES += ", char (parameter_module), ".f90"
	write (unit, "(5A)") "OBJECTS += ", char (parameter_module), ".lo"
	write (unit, "(5A)") char (parameter_module), ".f90:"
	write (unit, "(99A)") TAB, char (omega_path), &
	" -model:UFO_dir ", &
	char (writer%ufo_path), "/", char (writer%model_name), &
	" -model:exec", &
	" -target:parameter_module ", char (parameter_module), &
	" -params", &
	" -o $@"
	write (unit, "(5A)") char (parameter_module), ".lo: ", char (parameter_module), ".f90"
	if (.not. verbose) then
	write (unit, "(5A)") TAB // '@echo " FC " $@'
	end if
	write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"
	type is (omega_ovm_writer_t)
	write (unit, "(5A)") char (id), ".hbc:"
	write (unit, "(99A)") TAB, char (omega_path), &
	" -o ", char (id), ".hbc", &
	char (progress_string), &
	char (cms_string), &
	char (writer%process_mode), char (writer%process_string), &
	char (restrictions_string), char (diagrams_string), &
	char (writer%extra_options), char (write_phs_output_string)
	write (unit, "(5A)") char (id), ".f90:"
	if (.not. verbose) then
	write (unit, "(5A)") TAB // '@echo " OVM ', trim (char (id)), '.f90"'
	end if
	write (unit, "(99A)") TAB, char (omega_path), &
	" -o ", char (id), ".f90 -params", &
	" -target:whizard ", &
	" -target:bytecode_file ", char (id), ".hbc", &
	" -target:wrapper_module opr_", char (id), &
	" -target:parameter_module_external parameters_", &
	char (writer%model_name), &
	" -target:md5sum '", writer%md5sum, "'", &
	char (openmp_string)
	end select
	if (writer%diags .or. writer%diags_color) &
	write (unit, "(5A)") char (id), "_diags.tex: ", char (id), ".f90"
	write (unit, "(5A)") "clean-", char (id), ":"
	if (verbose) then
	write (unit, "(5A)") TAB, "rm -f ", char (id), ".f90"
	write (unit, "(5A)") TAB, "rm -f opr_", char (id), ".mod"
	write (unit, "(5A)") TAB, "rm -f ", char (id), ".lo"
	else
	write (unit, "(5A)") TAB // '@echo " RM ', &
	trim (char (id)), '.f90,.mod,.lo"'
	write (unit, "(5A)") TAB, "@rm -f ", char (id), ".f90"
	write (unit, "(5A)") TAB, "@rm -f opr_", char (id), ".mod"
	write (unit, "(5A)") TAB, "@rm -f ", char (id), ".lo"
	end if
	write (unit, "(5A)") "CLEAN_SOURCES += ", char (id), ".f90"
	select type (writer)
	type is (omega_ufo_writer_t)
	write (unit, "(5A)") "CLEAN_SOURCES += ", char (writer%model_name), ".mdl"
	write (unit, "(5A)") "CLEAN_SOURCES += ", char (parameter_module), ".f90"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (parameter_module), ".mod"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (parameter_module), ".lo"
	type is (omega_ovm_writer_t)
	write (unit, "(5A)") "CLEAN_SOURCES += ", char (id), ".hbc"
	end select
	if (writer%diags .or. writer%diags_color) then
	write (unit, "(5A)") "CLEAN_SOURCES += ", char (id), "_diags.tex"
	end if
	write (unit, "(5A)") "CLEAN_OBJECTS += opr_", char (id), ".mod"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), ".lo"
	if (writer%diags .or. writer%diags_color) then
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags.aux"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags.log"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags.dvi"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags.toc"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags.out"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags-fmf.[1-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags-fmf.[1-9][0-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags-fmf.[1-9][0-9][0-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags-fmf.t[1-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags-fmf.t[1-9][0-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags-fmf.t[1-9][0-9][0-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags-fmf.mp"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags-fmf.log"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags.dvi"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags.ps"
	if (os_data%event_analysis_pdf) &
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_diags.pdf"
	end if
	write (unit, "(5A)") char (id), ".lo: ", char (id), ".f90"
	write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"
	if (writer%diags .or. writer%diags_color) then
	if (os_data%event_analysis_ps) then
	if (os_data%event_analysis_pdf) then
	write (unit, "(5A)") char (id), "_diags.pdf: ", char (id), "_diags.tex"
	else
	write (unit, "(5A)") char (id), "_diags.ps: ", char (id), "_diags.tex"
	end if
	if (escape_hyperref) then
	if (verbose) then
	write (unit, "(5A)") TAB, "-cat ", char (id), "_diags.tex \| \"
	else
	write (unit, "(5A)") TAB // '@echo " HYPERREF ', &
	trim (char (id)) // '_diags.tex"'
	write (unit, "(5A)") TAB, "@cat ", char (id), "_diags.tex \| \"
	end if
	write (unit, "(5A)") TAB, " sed -e" // &
	"'s/\\usepackage\[colorlinks\]{hyperref}.*/%\\usepackage" // &
	"\[colorlinks\]{hyperref}/' > \"
	write (unit, "(5A)") TAB, " ", char (id), "_diags.tex.tmp"
	if (verbose) then
	write (unit, "(5A)") TAB, "mv -f ", char (id), "_diags.tex.tmp \"
	else
	write (unit, "(5A)") TAB, "@mv -f ", char (id), "_diags.tex.tmp \"
	end if
	write (unit, "(5A)") TAB, " ", char (id), "_diags.tex"
	end if
	if (verbose) then
	write (unit, "(5A)") TAB, "-TEXINPUTS=$(TEX_FLAGS) $(LATEX) " // &
	char (id) // "_diags.tex"
	write (unit, "(5A)") TAB, "MPINPUTS=$(MP_FLAGS) $(MPOST) " // &
	char (id) // "_diags-fmf.mp"
	write (unit, "(5A)") TAB, "TEXINPUTS=$(TEX_FLAGS) $(LATEX) " // &
	char (id) // "_diags.tex"
	write (unit, "(5A)") TAB, "$(DVIPS) -o " // char (id) // "_diags.ps " // &
	char (id) // "_diags.dvi"
	else
	write (unit, "(5A)") TAB // '@echo " LATEX ', &
	trim (char (id)) // '_diags.tex"'
	write (unit, "(5A)") TAB, "@TEXINPUTS=$(TEX_FLAGS) $(LATEX) " // &
	char (id) // "_diags.tex > /dev/null"
	write (unit, "(5A)") TAB // '@echo " METAPOST ', &
	trim (char (id)) // '_diags-fmf.mp"'
	write (unit, "(5A)") TAB, "@MPINPUTS=$(MP_FLAGS) $(MPOST) " // &
	char (id) // "_diags-fmf.mp > /dev/null"
	write (unit, "(5A)") TAB // '@echo " LATEX ', &
	trim (char (id)) // '_diags.tex"'
	write (unit, "(5A)") TAB, "@TEXINPUTS=$(TEX_FLAGS) $(LATEX) " // &
	char (id) // "_diags.tex > /dev/null"
	write (unit, "(5A)") TAB // '@echo " DVIPS ', &
	trim (char (id)) // '_diags.dvi"'
	write (unit, "(5A)") TAB, "@$(DVIPS) -q -o " // char (id) &
	// "_diags.ps " // char (id) // "_diags.dvi"
	end if
	if (os_data%event_analysis_pdf) then
	if (verbose) then
	write (unit, "(5A)") TAB, "$(PS2PDF) " // char (id) // "_diags.ps"
	else
	write (unit, "(5A)") TAB // '@echo " PS2PDF ', &
	trim (char (id)) // '_diags.ps"'
	write (unit, "(5A)") TAB, "@$(PS2PDF) " // char (id) // "_diags.ps"
	end if
	end if
	end if
	end if
	end subroutine omega_write_makefile_code

	@ %def omega_write_makefile_code
	@ The source is written by the makefile, so nothing to do here.
	<<Omega interface: omega writer: TBP>>=
	procedure :: write_source_code => omega_write_source_code
	<<Omega interface: sub interfaces>>=
	module subroutine omega_write_source_code (writer, id)
	class(omega_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine omega_write_source_code
	<<Omega interface: procedures>>=
	module subroutine omega_write_source_code (writer, id)
	class(omega_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine omega_write_source_code

	@ %def omega_write_source_code
	@ Nothing to be done here.
	<<Omega interface: omega writer: TBP>>=
	procedure :: before_compile => omega_before_compile
	procedure :: after_compile => omega_after_compile
	<<Omega interface: sub interfaces>>=
	module subroutine omega_before_compile (writer, id)
	class(omega_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine omega_before_compile
	module subroutine omega_after_compile (writer, id)
	class(omega_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine omega_after_compile
	<<Omega interface: procedures>>=
	module subroutine omega_before_compile (writer, id)
	class(omega_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine omega_before_compile

	module subroutine omega_after_compile (writer, id)
	class(omega_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine omega_after_compile

	@ %def omega_before_compile
	@ %def omega_after_compile
	@ Return the name of a procedure that implements a given feature, as
	it is provided by the external matrix-element code. \oMega\ names
	some procedures differently, therefore we translate here and override
	the binding of the base type.
	<<Omega interface: omega writer: TBP>>=
	procedure, nopass :: get_procname => omega_writer_get_procname
	<<Omega interface: sub interfaces>>=
	module function omega_writer_get_procname (feature) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: feature
	end function omega_writer_get_procname
	<<Omega interface: procedures>>=
	module function omega_writer_get_procname (feature) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: feature
	select case (char (feature))
	case ("n_in"); name = "number_particles_in"
	case ("n_out"); name = "number_particles_out"
	case ("n_flv"); name = "number_flavor_states"
	case ("n_hel"); name = "number_spin_states"
	case ("n_col"); name = "number_color_flows"
	case ("n_cin"); name = "number_color_indices"
	case ("n_cf"); name = "number_color_factors"
	case ("flv_state"); name = "flavor_states"
	case ("hel_state"); name = "spin_states"
	case ("col_state"); name = "color_flows"
	case default
	name = feature
	end select
	end function omega_writer_get_procname

	@ %def omega_writer_get_procname
	@ The interfaces for the \oMega-specific features.
	<<Omega interface: omega writer: TBP>>=
	procedure :: write_interface => omega_write_interface
	<<Omega interface: sub interfaces>>=
	module subroutine omega_write_interface (writer, unit, id, feature)
	class(omega_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(string_t), intent(in) :: feature
	end subroutine omega_write_interface
	<<Omega interface: procedures>>=
	module subroutine omega_write_interface (writer, unit, id, feature)
	class(omega_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(string_t), intent(in) :: feature
	type(string_t) :: name
	name = writer%get_c_procname (id, feature)
	write (unit, "(2x,9A)") "interface"
	select case (char (feature))
	case ("init")
	write (unit, "(5x,9A)") "subroutine ", char (name), &
	" (par, scheme) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "real(c_default_float), dimension(*), &
	&intent(in) :: par"
	write (unit, "(7x,9A)") "integer(c_int), intent(in) :: scheme"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("update_alpha_s")
	write (unit, "(5x,9A)") "subroutine ", char (name), " (alpha_s) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "real(c_default_float), intent(in) :: alpha_s"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("reset_helicity_selection")
	write (unit, "(5x,9A)") "subroutine ", char (name), " &
	&(threshold, cutoff) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "real(c_default_float), intent(in) :: threshold"
	write (unit, "(7x,9A)") "integer(c_int), intent(in) :: cutoff"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("is_allowed")
	write (unit, "(5x,9A)") "subroutine ", char (name), " &
	&(flv, hel, col, flag) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(7x,9A)") "logical(c_bool), intent(out) :: flag"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("new_event")
	write (unit, "(5x,9A)") "subroutine ", char (name), " (p) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "real(c_default_float), dimension(0:3,*), &
	&intent(in) :: p"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("get_amplitude")
	write (unit, "(5x,9A)") "subroutine ", char (name), " &
	&(flv, hel, col, amp) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(7x,9A)") "complex(c_default_complex), intent(out) &
	&:: amp"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	end select
	write (unit, "(2x,9A)") "end interface"
	end subroutine omega_write_interface

	@ %def omega_write_interface
	@ The wrappers have to take into account conversion between C and
	Fortran data types.

	NOTE: The case [[c_default_float]] $\neq$ [[default]] is not yet covered.
	<<Omega interface: omega writer: TBP>>=
	procedure :: write_wrapper => omega_write_wrapper
	<<Omega interface: sub interfaces>>=
	module subroutine omega_write_wrapper (writer, unit, id, feature)
	class(omega_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	end subroutine omega_write_wrapper
	<<Omega interface: procedures>>=
	module subroutine omega_write_wrapper (writer, unit, id, feature)
	class(omega_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	type(string_t) :: name
	name = writer%get_c_procname (id, feature)
	write (unit, *)
	select case (char (feature))
	case ("init")
	write (unit, "(9A)") "subroutine ", char (name), &
	" (par, scheme) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	write (unit, "(2x,9A)") "real(c_default_float), dimension(*), &
	&intent(in) :: par"
	write (unit, "(2x,9A)") "integer(c_int), intent(in) :: scheme"
	if (c_default_float == default .and. c_int == kind(1)) then
	write (unit, "(2x,9A)") "call ", char (feature), " (par, scheme)"
	end if
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("update_alpha_s")
	write (unit, "(9A)") "subroutine ", char (name), " (alpha_s) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	if (c_default_float == default) then
	write (unit, "(2x,9A)") "real(c_default_float), intent(in) &
	&:: alpha_s"
	write (unit, "(2x,9A)") "call ", char (feature), " (alpha_s)"
	end if
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("reset_helicity_selection")
	write (unit, "(9A)") "subroutine ", char (name), &
	" (threshold, cutoff) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	if (c_default_float == default) then
	write (unit, "(2x,9A)") "real(c_default_float), intent(in) &
	&:: threshold"
	write (unit, "(2x,9A)") "integer(c_int), intent(in) :: cutoff"
	write (unit, "(2x,9A)") "call ", char (feature), &
	" (threshold, int (cutoff))"
	end if
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("is_allowed")
	write (unit, "(9A)") "subroutine ", char (name), &
	" (flv, hel, col, flag) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	write (unit, "(2x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(2x,9A)") "logical(c_bool), intent(out) :: flag"
	write (unit, "(2x,9A)") "flag = ", char (feature), &
	" (int (flv), int (hel), int (col))"
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("new_event")
	write (unit, "(9A)") "subroutine ", char (name), " (p) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	if (c_default_float == default) then
	write (unit, "(2x,9A)") "real(c_default_float), dimension(0:3,*), &
	&intent(in) :: p"
	write (unit, "(2x,9A)") "call ", char (feature), " (p)"
	end if
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("get_amplitude")
	write (unit, "(9A)") "subroutine ", char (name), &
	" (flv, hel, col, amp) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	write (unit, "(2x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(2x,9A)") "complex(c_default_complex), intent(out) &
	&:: amp"
	write (unit, "(2x,9A)") "amp = ", char (feature), &
	" (int (flv), int (hel), int (col))"
	write (unit, "(9A)") "end subroutine ", char (name)
	end select
	end subroutine omega_write_wrapper

	@ %def omega_write_wrapper
	@
	\subsection{Driver}
	<<Omega interface: public>>=
	public :: omega_driver_t
	<<Omega interface: types>>=
	type, extends (prc_core_driver_t) :: omega_driver_t
	procedure(init_t), nopass, pointer :: &
	init => null ()
	procedure(update_alpha_s_t), nopass, pointer :: &
	update_alpha_s => null ()
	procedure(reset_helicity_selection_t), nopass, pointer :: &
	reset_helicity_selection => null ()
	procedure(is_allowed_t), nopass, pointer :: &
	is_allowed => null ()
	procedure(new_event_t), nopass, pointer :: &
	new_event => null ()
	procedure(get_amplitude_t), nopass, pointer :: &
	get_amplitude => null ()
	contains
	<<Omega interface: omega driver: TBP>>
	end type omega_driver_t

	@ %def omega_driver_t
	@ The reported type is the same as for the [[omega_def_t]] type.
	<<Omega interface: omega driver: TBP>>=
	procedure, nopass :: type_name => omega_driver_type_name
	<<Omega interface: sub interfaces>>=
	module function omega_driver_type_name () result (string)
	type(string_t) :: string
	end function omega_driver_type_name
	<<Omega interface: procedures>>=
	module function omega_driver_type_name () result (string)
	type(string_t) :: string
	string = "omega"
	end function omega_driver_type_name

	@ %def omega_driver_type_name
	@
	\subsection{High-level process definition}
	This procedure wraps the details filling a process-component
	definition entry as appropriate for an
	\oMega\ matrix element.
	Gfortran 7/8/9 bug, has to remain in the main module.
	<<Omega interface: public>>=
	public :: omega_make_process_component
	<<Omega interface: main procedures>>=
	subroutine omega_make_process_component (entry, component_index, &
	model_name, prt_in, prt_out, &
	ufo, ufo_path, restrictions, cms_scheme, &
	openmp_support, report_progress, write_omega_output, extra_options, diags, diags_color)
	class(process_def_entry_t), intent(inout) :: entry
	integer, intent(in) :: component_index
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	logical, intent(in), optional :: cms_scheme
	logical, intent(in), optional :: openmp_support
	logical, intent(in), optional :: report_progress
	logical, intent(in), optional :: write_omega_output
	type(string_t), intent(in), optional :: extra_options
	logical, intent(in), optional :: diags, diags_color
	logical :: ufo_model
	class(prc_core_def_t), allocatable :: def
	ufo_model = .false.; if (present (ufo)) ufo_model = ufo
	allocate (omega_def_t :: def)
	select type (def)
	class is (omega_def_t)
	call def%init (model_name, prt_in, prt_out, &
	.false., ufo_model, ufo_path, &
	restrictions, cms_scheme, &
	openmp_support, report_progress, write_omega_output, extra_options, diags, diags_color)
	end select
	call entry%import_component (component_index, &
	n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("omega"), &
	variant = def)
	end subroutine omega_make_process_component

	@ %def omega_make_process_component
	@
	\subsection{The [[prc_omega_t]] wrapper}
	This is an instance of the generic [[prc_core_t]] object. It contains a
	pointer to the process definition ([[omega_def_t]]), a data component
	([[process_constants_t]]), and the matrix-element driver
	([[omega_driver_t]]).
	<<Omega interface: public>>=
	public :: prc_omega_t
	<<Omega interface: types>>=
	type, extends (prc_core_t) :: prc_omega_t
	real(default), dimension(:), allocatable :: par
	integer :: scheme = 0
	type(helicity_selection_t) :: helicity_selection
	type(qcd_t) :: qcd
	type(qed_t) :: qed
	contains
	<<Omega interface: prc omega: TBP>>
	end type prc_omega_t

	@ %def prc_omega_t
	@ The workspace associated to a [[prc_omega_t]] object contains a single flag.
	The flag is used to suppress re-evaluating the matrix element for each
	quantum-number combination, after the first amplitude belonging to a given
	kinematics has been computed.

	We can also store the value of a running coupling once it has been calculated
	for an event. The default value is negative, which indicates an undefined
	value in this context.
	<<Omega interface: public>>=
	public :: omega_state_t
	<<Omega interface: types>>=
	type, extends (prc_core_state_t) :: omega_state_t
	logical :: new_kinematics = .true.
	real(default) :: alpha_qcd = -1
	real(default) :: alpha_qed = -1
	contains
	<<Omega interface: omega state: TBP>>
	end type omega_state_t

	@ %def omega_state_t
	@
	<<Omega interface: omega state: TBP>>=
	procedure :: write => omega_state_write
	<<Omega interface: sub interfaces>>=
	module subroutine omega_state_write (object, unit)
	class(omega_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine omega_state_write
	<<Omega interface: procedures>>=
	module subroutine omega_state_write (object, unit)
	class(omega_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A,L1)") "O'Mega state: new kinematics = ", &
	object%new_kinematics
	end subroutine omega_state_write

	@ %def omega_state_write
	<<Omega interface: omega state: TBP>>=
	procedure :: reset_new_kinematics => omega_state_reset_new_kinematics
	<<Omega interface: sub interfaces>>=
	module subroutine omega_state_reset_new_kinematics (object)
	class(omega_state_t), intent(inout) :: object
	end subroutine omega_state_reset_new_kinematics
	<<Omega interface: procedures>>=
	module subroutine omega_state_reset_new_kinematics (object)
	class(omega_state_t), intent(inout) :: object
	object%new_kinematics = .true.
	end subroutine omega_state_reset_new_kinematics

	@ %def omega_state_reset_new_kinematics
	@ Allocate the workspace with the above specific type.
	Gfortran 7/8/9 bug, has to remain in main module.
	<<Omega interface: prc omega: TBP>>=
	procedure :: allocate_workspace => prc_omega_allocate_workspace
	<<Omega interface: main procedures>>=
	subroutine prc_omega_allocate_workspace (object, core_state)
	class(prc_omega_t), intent(in) :: object
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	allocate (omega_state_t :: core_state)
	end subroutine prc_omega_allocate_workspace

	@ %def prc_omega_allocate_workspace
	@ The following procedures are inherited from the base type as deferred, thus
	must be implemented. The corresponding unit tests are skipped here; the
	procedures are tested when called from the [[processes]] module.

	Output: print just the ID of the associated matrix element. Then display any
	stored parameters and the helicity selection data. (The latter are printed
	only if active.)
	<<Omega interface: prc omega: TBP>>=
	procedure :: write => prc_omega_write
	<<Omega interface: sub interfaces>>=
	module subroutine prc_omega_write (object, unit)
	class(prc_omega_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_omega_write
	<<Omega interface: procedures>>=
	module subroutine prc_omega_write (object, unit)
	class(prc_omega_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(3x,A)", advance="no") "O'Mega process core:"
	if (object%data_known) then
	write (u, "(1x,A)") char (object%data%id)
	else
	write (u, "(1x,A)") "[undefined]"
	end if
	if (allocated (object%par)) then
	write (u, "(3x,A)") "Parameter array:"
	do i = 1, size (object%par)
	write (u, "(5x,I0,1x,ES17.10)") i, object%par(i)
	end do
	end if
	call object%helicity_selection%write (u)
	call object%qcd%write (u)
	call object%qed%write (u)
	end subroutine prc_omega_write

	@ %def prc_omega_write
	@
	<<Omega interface: prc omega: TBP>>=
	procedure :: write_name => prc_omega_write_name
	<<Omega interface: sub interfaces>>=
	module subroutine prc_omega_write_name (object, unit)
	class(prc_omega_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_omega_write_name
	<<Omega interface: procedures>>=
	module subroutine prc_omega_write_name (object, unit)
	class(prc_omega_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u,"(1x,A)") "Core: O'Mega"
	end subroutine prc_omega_write_name

	@ %def prc_omega_write_name
	@ Temporarily store the parameter array inside the [[prc_omega]]
	object, so we can use it later during the actual initialization. Also
	store threshold and cutoff for helicity selection.
	Gfortran 7/8/9 bug, has to remain in the main module.
	<<Omega interface: prc omega: TBP>>=
	procedure :: set_parameters => prc_omega_set_parameters
	<<Omega interface: main procedures>>=
	subroutine prc_omega_set_parameters (prc_omega, model, &
	helicity_selection, qcd, use_color_factors)
	class(prc_omega_t), intent(inout) :: prc_omega
	class(model_data_t), intent(in), target, optional :: model
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	type(qcd_t), intent(in), optional :: qcd
	type(qed_t) :: qed
	logical, intent(in), optional :: use_color_factors
	if (present (model)) then
	if (.not. allocated (prc_omega%par)) &
	allocate (prc_omega%par (model%get_n_real ()))
	call model%real_parameters_to_array (prc_omega%par)
	prc_omega%scheme = model%get_scheme_num ()
	if (associated (model%get_par_data_ptr (var_str ('alpha_em_i')))) then
	allocate (alpha_qed_fixed_t :: qed%alpha)
	select type (alpha => qed%alpha)
	type is (alpha_qed_fixed_t)
	alpha%val = one / model%get_real (var_str ('alpha_em_i'))
	end select
	end if
	prc_omega%qed = qed
	end if
	if (present (helicity_selection)) then
	prc_omega%helicity_selection = helicity_selection
	end if
	if (present (qcd)) then
	prc_omega%qcd = qcd
	end if
	if (present (use_color_factors)) then
	prc_omega%use_color_factors = use_color_factors
	end if
	end subroutine prc_omega_set_parameters

	@ %def prc_omega_set_parameters
	@ To fully initialize the process core, we perform base
	initialization, then initialize the external matrix element code.

	This procedure overrides the [[init]] method of the base type, which
	we nevertheless can access via its binding [[base_init]]. When done, we
	have an allocated driver. The driver will call the [[init]] procedure
	for the external matrix element, and thus transfer the parameter set to
	where it finally belongs.

	If requested, we initialize the helicity selction counter.
	<<Omega interface: prc omega: TBP>>=
	procedure :: init => prc_omega_init
	<<Omega interface: sub interfaces>>=
	module subroutine prc_omega_init (object, def, lib, id, i_component)
	class(prc_omega_t), intent(inout) :: object
	class(prc_core_def_t), intent(in), target :: def
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	end subroutine prc_omega_init
	<<Omega interface: procedures>>=
	module subroutine prc_omega_init (object, def, lib, id, i_component)
	class(prc_omega_t), intent(inout) :: object
	class(prc_core_def_t), intent(in), target :: def
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	call object%base_init (def, lib, id, i_component)
	call object%activate_parameters ()
	end subroutine prc_omega_init

	@ %def prc_omega_init
	@ Activate the stored parameters by transferring them to the external
	matrix element. Also reset the helicity selection, if requested.
	<<Omega interface: prc omega: TBP>>=
	procedure :: activate_parameters => prc_omega_activate_parameters
	<<Omega interface: sub interfaces>>=
	module subroutine prc_omega_activate_parameters (object)
	class (prc_omega_t), intent(inout) :: object
	end subroutine prc_omega_activate_parameters
	<<Omega interface: procedures>>=
	module subroutine prc_omega_activate_parameters (object)
	class (prc_omega_t), intent(inout) :: object
	if (allocated (object%driver)) then
	if (allocated (object%par)) then
	select type (driver => object%driver)
	type is (omega_driver_t)
	if (associated (driver%init)) then
	call driver%init (object%par, object%scheme)
	end if
	end select
	else
	call msg_bug ("prc_omega_activate: parameter set is not allocated")
	end if
	call object%reset_helicity_selection ()
	else
	call msg_bug ("prc_omega_activate: driver is not allocated")
	end if
	end subroutine prc_omega_activate_parameters

	@ %def prc_omega_activate_parameters
	@ Tell whether a particular combination of flavor, helicity, color is
	allowed. Here we have to consult the matrix-element driver.
	<<Omega interface: prc omega: TBP>>=
	procedure :: is_allowed => prc_omega_is_allowed
	<<Omega interface: sub interfaces>>=
	module function prc_omega_is_allowed (object, i_term, f, h, c) result (flag)
	class(prc_omega_t), intent(in) :: object
	integer, intent(in) :: i_term, f, h, c
	logical :: flag
	end function prc_omega_is_allowed
	<<Omega interface: procedures>>=
	module function prc_omega_is_allowed (object, i_term, f, h, c) result (flag)
	class(prc_omega_t), intent(in) :: object
	integer, intent(in) :: i_term, f, h, c
	logical :: flag
	logical(c_bool) :: cflag
	select type (driver => object%driver)
	type is (omega_driver_t)
	call driver%is_allowed (f, h, c, cflag)
	flag = cflag
	end select
	end function prc_omega_is_allowed

	@ %def prc_omega_is_allowed
	@ Transfer the generated momenta directly to the hard interaction in
	the (only) term. We assume that everything has been set up correctly,
	so the array fits.

	We don't reset the [[new_kinematics]] flag here. This has to be done
	explicitly by the caller ([[reset_new_kinematics]]) when a new kinematics
	configuration is to be considered.
	<<Omega interface: prc omega: TBP>>=
	procedure :: compute_hard_kinematics => prc_omega_compute_hard_kinematics
	<<Omega interface: sub interfaces>>=
	module subroutine prc_omega_compute_hard_kinematics &
	(object, p_seed, i_term, int_hard, core_state)
	class(prc_omega_t), intent(in) :: object
	type(vector4_t), dimension(:), intent(in) :: p_seed
	integer, intent(in) :: i_term
	type(interaction_t), intent(inout) :: int_hard
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_omega_compute_hard_kinematics
	<<Omega interface: procedures>>=
	module subroutine prc_omega_compute_hard_kinematics &
	(object, p_seed, i_term, int_hard, core_state)
	class(prc_omega_t), intent(in) :: object
	type(vector4_t), dimension(:), intent(in) :: p_seed
	integer, intent(in) :: i_term
	type(interaction_t), intent(inout) :: int_hard
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	call int_hard%set_momenta (p_seed)
	end subroutine prc_omega_compute_hard_kinematics

	@ %def prc_omega_compute_hard_kinematics
	@ This procedure is not called for [[prc_omega_t]], just a placeholder.
	<<Omega interface: prc omega: TBP>>=
	procedure :: compute_eff_kinematics => prc_omega_compute_eff_kinematics
	<<Omega interface: sub interfaces>>=
	module subroutine prc_omega_compute_eff_kinematics &
	(object, i_term, int_hard, int_eff, core_state)
	class(prc_omega_t), intent(in) :: object
	integer, intent(in) :: i_term
	type(interaction_t), intent(in) :: int_hard
	type(interaction_t), intent(inout) :: int_eff
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_omega_compute_eff_kinematics
	<<Omega interface: procedures>>=
	module subroutine prc_omega_compute_eff_kinematics &
	(object, i_term, int_hard, int_eff, core_state)
	class(prc_omega_t), intent(in) :: object
	integer, intent(in) :: i_term
	type(interaction_t), intent(in) :: int_hard
	type(interaction_t), intent(inout) :: int_eff
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_omega_compute_eff_kinematics

	@ %def prc_omega_compute_eff_kinematics
	@ Reset the helicity selection counters and start counting zero
	helicities. We assume that the [[helicity_selection]] object is allocated.
	Otherwise, reset and switch off helicity counting.

	In the test routine, the driver is allocated but the driver methods are not.
	Therefore, guard against a disassociated method.
	<<Omega interface: prc omega: TBP>>=
	procedure :: reset_helicity_selection => prc_omega_reset_helicity_selection
	<<Omega interface: sub interfaces>>=
	module subroutine prc_omega_reset_helicity_selection (object)
	class(prc_omega_t), intent(inout) :: object
	end subroutine prc_omega_reset_helicity_selection
	<<Omega interface: procedures>>=
	module subroutine prc_omega_reset_helicity_selection (object)
	class(prc_omega_t), intent(inout) :: object
	select type (driver => object%driver)
	type is (omega_driver_t)
	if (associated (driver%reset_helicity_selection)) then
	if (object%helicity_selection%active) then
	call driver%reset_helicity_selection &
	(real (object%helicity_selection%threshold, &
	c_default_float), &
	int (object%helicity_selection%cutoff, c_int))
	else
	call driver%reset_helicity_selection &
	(0._c_default_float, 0_c_int)
	end if
	end if
	end select
	end subroutine prc_omega_reset_helicity_selection

	@ %def reset_helicity_selection
	@ Compute the amplitude. For the tree-level process, we can ignore the scale
	settings. The term index [[j]] is also irrelevant.

	We first call [[new_event]] for the given momenta (which we must unpack), then
	retrieve the amplitude value for the given quantum numbers.

	If the [[core_state]] status flag is present, we can make sure that we call
	[[new_event]] only once for a given kinematics. After the first call, we
	unset the [[new_kinematics]] flag.

	The core objects computes the appropriate $\alpha_s$ value via the [[qcd]]
	subobject, taking into account the provided [[ren_scale]] value. However, if
	the extra parameter [[alpha_qcd_forced]] is allocated, it overrides this
	setting.

	The [[is_allowed]] query is not redundant, since the status may change during
	the run if helicities are switched off.
	<<Omega interface: prc omega: TBP>>=
	procedure :: compute_amplitude => prc_omega_compute_amplitude
	<<Omega interface: sub interfaces>>=
	module function prc_omega_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(prc_omega_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: &
	core_state
	complex(default) :: amp
	end function prc_omega_compute_amplitude
	<<Omega interface: procedures>>=
	module function prc_omega_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(prc_omega_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: core_state
	real(default) :: alpha_qcd
	complex(default) :: amp
	integer :: n_tot, i
	real(c_default_float), dimension(:,:), allocatable :: parray
	complex(c_default_complex) :: camp
	logical :: new_event
	select type (driver => object%driver)
	type is (omega_driver_t)
	new_event = .true.
	if (present (core_state)) then
	if (allocated (core_state)) then
	select type (core_state)
	type is (omega_state_t)
	new_event = core_state%new_kinematics
	core_state%new_kinematics = .false.
	end select
	end if
	end if
	if (new_event) then
	if (allocated (object%qcd%alpha)) then
	if (allocated (alpha_qcd_forced)) then
	alpha_qcd = alpha_qcd_forced
	else
	alpha_qcd = object%qcd%alpha%get (ren_scale)
	end if
	call driver%update_alpha_s (alpha_qcd)
	if (present (core_state)) then
	if (allocated (core_state)) then
	select type (core_state)
	type is (omega_state_t)
	core_state%alpha_qcd = alpha_qcd
	end select
	end if
	end if
	end if
	n_tot = object%data%get_n_tot ()
	allocate (parray (0:3, n_tot))
	do i = 1, n_tot
	parray(:,i) = vector4_get_components (p(i))
	end do
	call driver%new_event (parray)
	end if
	if (object%is_allowed (1, f, h, c)) then
	call driver%get_amplitude &
	(int (f, c_int), int (h, c_int), int (c, c_int), camp)
	amp = camp
	else
	amp = 0
	end if
	end select
	end function prc_omega_compute_amplitude

	@ %def prc_omega_compute_amplitude
	@ After the amplitude has been computed, we may read off the current value of
	$\alpha_s$. This works only if $\alpha_s$ varies, and if the workspace
	[[core_state]] is present which stores this value.
	<<Omega interface: prc omega: TBP>>=
	procedure :: get_alpha_s => prc_omega_get_alpha_s
	<<Omega interface: sub interfaces>>=
	module function prc_omega_get_alpha_s &
	(object, core_state) result (alpha_qcd)
	class(prc_omega_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qcd
	end function prc_omega_get_alpha_s
	<<Omega interface: procedures>>=
	module function prc_omega_get_alpha_s &
	(object, core_state) result (alpha_qcd)
	class(prc_omega_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qcd
	alpha_qcd = -1
	if (allocated (object%qcd%alpha) .and. allocated (core_state)) then
	select type (core_state)
	type is (omega_state_t)
	alpha_qcd = core_state%alpha_qcd
	end select
	end if
	end function prc_omega_get_alpha_s

	@ %def prc_omega_get_alpha_s
	@ After the amplitude has been computed, we may read off the current value of
	$\alpha$. This works only if $\alpha$ varies, and if the workspace
	[[core_state]] is present which stores this value.
	<<Omega interface: prc omega: TBP>>=
	procedure :: get_alpha_qed => prc_omega_get_alpha_qed
	<<Omega interface: sub interfaces>>=
	module function prc_omega_get_alpha_qed &
	(object, core_state) result (alpha_qed)
	class(prc_omega_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qed
	end function prc_omega_get_alpha_qed
	<<Omega interface: procedures>>=
	module function prc_omega_get_alpha_qed &
	(object, core_state) result (alpha_qed)
	class(prc_omega_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qed
	alpha_qed = -1
	if (allocated (object%qed%alpha) .and. allocated (core_state)) then
	select type (core_state)
	type is (omega_state_t)
	alpha_qed = core_state%alpha_qed
	end select
	end if
	end function prc_omega_get_alpha_qed

	@ %def prc_omega_get_alpha_qed
	@
	\subsection{Unit Test}
	Test module, followed by the corresponding implementation module.
	There is a separate test for testing \oMega\ diagram generation as
	this depends on a working analysis setup.
	<<[[prc_omega_ut.f90]]>>=
	<<File header>>

	module prc_omega_ut
	use unit_tests
	use prc_omega_uti

	<<Standard module head>>

	<<Omega interface: public test>>

	contains

	<<Omega interface: test driver>>

	end module prc_omega_ut
	@ %def prc_omega_ut
	@
	<<[[prc_omega_uti.f90]]>>=
	<<File header>>

	module prc_omega_uti

	use, intrinsic :: iso_c_binding !NODEP!

	use kinds
	<<Use strings>>
	use io_units
	use file_utils, only: delete_file
	use os_interface
	use sm_qcd
	use lorentz
	use model_data
	use var_base
	use particle_specifiers, only: new_prt_spec
	use prc_core_def
	use process_constants
	use process_libraries
	use prc_core
	use model_testbed, only: prepare_model, cleanup_model

	use prc_omega

	<<Standard module head>>

	<<Omega interface: test declarations>>

	contains

	<<Omega interface: tests>>

	end module prc_omega_uti
	@ %def prc_omega_ut
	@ API: driver for the unit tests below.
	<<Omega interface: public test>>=
	public :: prc_omega_test
	<<Omega interface: test driver>>=
	subroutine prc_omega_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Omega interface: execute tests>>
	end subroutine prc_omega_test

	@ %def prc_omega_test
	@
	<<Omega interface: public test>>=
	public :: prc_omega_diags_test
	<<Omega interface: test driver>>=
	subroutine prc_omega_diags_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Omega interface: execute diags tests>>
	end subroutine prc_omega_diags_test

	@ %def prc_omega_diags_test
	@
	\subsubsection{Generate, compile and load a simple process matrix element}
	The process is $e^+ e^- \to \mu^+\mu^-$ for vanishing masses and
	$e=0.3$. We initialize the process, build the library, and compute a
	particular matrix element for momenta of unit energy and right-angle
	scattering. The matrix element, as it happens, is equal to $e^2$.
	(Note that are no conversion factors applied, so this result is
	exact.)

	For [[GNU make]], [[makeflags]] is set to [[-j1]]. This eliminates a
	potential clash with a [[-j<n>]] flag if this test is called from a
	parallel make.
	<<Omega interface: execute tests>>=
	call test (prc_omega_1, "prc_omega_1", &
	"build and load simple OMega process", &
	u, results)
	<<Omega interface: test declarations>>=
	public :: prc_omega_1
	<<Omega interface: tests>>=
	subroutine prc_omega_1 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry
	type(os_data_t) :: os_data
	type(string_t) :: model_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(process_constants_t) :: data
	class(prc_core_driver_t), allocatable :: driver
	integer, parameter :: cdf = c_default_float
	integer, parameter :: ci = c_int
	real(cdf), dimension(4) :: par
	real(cdf), dimension(0:3,4) :: p
	logical(c_bool) :: flag
	complex(c_default_complex) :: amp
	integer :: i

	write (u, "(A)") "* Test output: prc_omega_1"
	write (u, "(A)") "* Purpose: create a simple process with OMega"
	write (u, "(A)") "* build a library, link, load, and &
	&access the matrix element"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry"
	write (u, "(A)")
	call lib%init (var_str ("omega1"))
	call os_data%init ()

	model_name = "QED"
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("m+"), var_str ("m-")]

	allocate (omega_def_t :: def)
	select type (def)
	type is (omega_def_t)
	call def%init (model_name, prt_in, prt_out, &
	ufo = .false., ovm = .false.)
	end select
	allocate (entry)
	call entry%init (var_str ("omega1_a"), model_name = model_name, &
	n_in = 2, n_components = 1)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("omega"), &
	variant = def)
	call lib%append (entry)

	write (u, "(A)") "* Configure library"
	write (u, "(A)")
	call lib%configure (os_data)

	write (u, "(A)") "* Write makefile"
	write (u, "(A)")
	call lib%write_makefile (os_data, force = .true., verbose = .false.)

	write (u, "(A)") "* Clean any left-over files"
	write (u, "(A)")
	call lib%clean (os_data, distclean = .false.)

	write (u, "(A)") "* Write driver"
	write (u, "(A)")
	call lib%write_driver (force = .true.)

	write (u, "(A)") "* Write process source code, compile, link, load"
	write (u, "(A)")
	call lib%load (os_data)

	call lib%write (u, libpath = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Probe library API:"
	write (u, "(A)")

	write (u, "(1x,A,L1)") "is active = ", &
	lib%is_active ()
	write (u, "(1x,A,I0)") "n_processes = ", &
	lib%get_n_processes ()

	write (u, "(A)")
	write (u, "(A)") "* Constants of omega1_a_i1:"
	write (u, "(A)")

	call lib%connect_process (var_str ("omega1_a"), 1, data, driver)

	write (u, "(1x,A,A)") "component ID = ", char (data%id)
	write (u, "(1x,A,A)") "model name = ", char (data%model_name)
	write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
	write (u, "(1x,A,L1)") "openmp supported = ", data%openmp_supported
	write (u, "(1x,A,I0)") "n_in = ", data%n_in
	write (u, "(1x,A,I0)") "n_out = ", data%n_out
	write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
	write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
	write (u, "(1x,A,I0)") "n_col = ", data%n_col
	write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
	write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
	write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
	write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,1)
	do i = 2, 16
	write (u, "(12x,4(1x,I2))") data%hel_state(:,i)
	end do
	write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
	write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
	write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
	write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index

	write (u, "(A)")
	write (u, "(A)") "* Set parameters for omega1_a and initialize:"
	write (u, "(A)")

	par = [0.3_cdf, 0.0_cdf, 0.0_cdf, 0.0_cdf]
	write (u, "(2x,A,F6.4)") "ee = ", par(1)
	write (u, "(2x,A,F6.4)") "me = ", par(2)
	write (u, "(2x,A,F6.4)") "mmu = ", par(3)
	write (u, "(2x,A,F6.4)") "mtau = ", par(4)

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics:"
	write (u, "(A)")

	p = reshape ([ &
	1.0_cdf, 0.0_cdf, 0.0_cdf, 1.0_cdf, &
	1.0_cdf, 0.0_cdf, 0.0_cdf,-1.0_cdf, &
	1.0_cdf, 1.0_cdf, 0.0_cdf, 0.0_cdf, &
	1.0_cdf,-1.0_cdf, 0.0_cdf, 0.0_cdf &
	], [4,4])
	do i = 1, 4
	write (u, "(2x,A,I0,A,4(1x,F7.4))") "p", i, " =", p(:,i)
	end do

	select type (driver)
	type is (omega_driver_t)
	call driver%init (par, 0)

	call driver%new_event (p)

	write (u, "(A)")
	write (u, "(A)") "* Compute matrix element:"
	write (u, "(A)")

	call driver%is_allowed (1_ci, 6_ci, 1_ci, flag)
	write (u, "(1x,A,L1)") "is_allowed (1, 6, 1) = ", flag

	call driver%get_amplitude (1_ci, 6_ci, 1_ci, amp)
	write (u, "(1x,A,1x,E11.4)") "\|amp (1, 6, 1)\| =", abs (amp)
	end select

	call lib%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: prc_omega_1"

	end subroutine prc_omega_1

	@ %def prc_omega_1
	@
	\subsubsection{Check [[prc_omega_t]] wrapper and options}
	The process is $e^- e^+ \to e^- e^+$ for vanishing masses and
	$e=0.3$. We build the library using the high-level procedure
	[[omega_make_process_component]] and the ``black box''
	[[prc_omega_t]] object. Two variants with different settings for
	restrictions and OpenMP.

	For [[GNU make]], [[makeflags]] is set to [[-j1]]. This eliminates a
	potential clash with a [[-j<n>]] flag if this test is called from a
	parallel make.
	<<Omega interface: execute tests>>=
	call test (prc_omega_2, "prc_omega_2", &
	"OMega option passing", &
	u, results)
	<<Omega interface: test declarations>>=
	public :: prc_omega_2
	<<Omega interface: tests>>=
	subroutine prc_omega_2 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(process_def_entry_t), pointer :: entry
	type(os_data_t) :: os_data
	type(string_t) :: model_name
	class(model_data_t), pointer :: model
	class(vars_t), pointer :: vars
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(string_t) :: restrictions
	type(process_component_def_t), pointer :: config
	type(prc_omega_t) :: prc1, prc2
	type(process_constants_t) :: data
	integer, parameter :: cdf = c_default_float
	integer, parameter :: ci = c_int
	real(cdf), dimension(:), allocatable :: par
	real(cdf), dimension(0:3,4) :: p
	complex(c_default_complex) :: amp
	integer :: i
	logical :: exist

	write (u, "(A)") "* Test output: prc_omega_2"
	write (u, "(A)") "* Purpose: create simple processes with OMega"
	write (u, "(A)") "* use the prc_omega wrapper for this"
	write (u, "(A)") "* and check OMega options"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with two entries, &
	&different options."
	write (u, "(A)") "* (1) e- e+ -> e- e+ &
	&(all diagrams, no OpenMP, report progress)"
	write (u, "(A)") "* (2) e- e+ -> e- e+ &
	&(s-channel only, with OpenMP, report progress to file)"

	call lib%init (var_str ("omega2"))
	call os_data%init ()

	model_name = "QED"
	model => null ()
	call prepare_model (model, model_name, vars)

	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e-"), var_str ("e+")]
	prt_out = prt_in
	restrictions = "3+4~A"

	allocate (entry)
	call entry%init (var_str ("omega2_a"), &
	model, n_in = 2, n_components = 2)

	call omega_make_process_component (entry, 1, &
	model_name, prt_in, prt_out, &
	report_progress=.true.)
	call omega_make_process_component (entry, 2, &
	model_name, prt_in, prt_out, &
	restrictions=restrictions, openmp_support=.true., &
	extra_options=var_str ("-fusion:progress_file omega2.log"))

	call lib%append (entry)

	write (u, "(A)")
	write (u, "(A)") "* Remove left-over file"
	write (u, "(A)")

	call delete_file ("omega2.log")
	inquire (file="omega2.log", exist=exist)
	write (u, "(1x,A,L1)") "omega2.log exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Build and load library"

	call lib%configure (os_data)
	call lib%write_makefile (os_data, force = .true., verbose = .false.)
	call lib%clean (os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (os_data)

	write (u, "(A)")
	write (u, "(A)") "* Check extra output of OMega"
	write (u, "(A)")

	inquire (file="omega2.log", exist=exist)
	write (u, "(1x,A,L1)") "omega2.log exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Probe library API:"
	write (u, "(A)")

	write (u, "(1x,A,L1)") "is active = ", &
	lib%is_active ()
	write (u, "(1x,A,I0)") "n_processes = ", &
	lib%get_n_processes ()

	write (u, "(A)")
	write (u, "(A)") "* Set parameters for omega2_a and initialize:"
	write (u, "(A)")

	call vars%set_rval (var_str ("ee"), 0.3_default)
	call vars%set_rval (var_str ("me"), 0._default)
	call vars%set_rval (var_str ("mmu"), 0._default)
	call vars%set_rval (var_str ("mtau"), 0._default)
	allocate (par (model%get_n_real ()))
	call model%real_parameters_to_c_array (par)

	write (u, "(2x,A,F6.4)") "ee = ", par(1)
	write (u, "(2x,A,F6.4)") "me = ", par(2)
	write (u, "(2x,A,F6.4)") "mmu = ", par(3)
	write (u, "(2x,A,F6.4)") "mtau = ", par(4)

	call prc1%set_parameters (model)
	call prc2%set_parameters (model)

	write (u, "(A)")
	write (u, "(A)") "* Constants of omega2_a_i1:"
	write (u, "(A)")

	entry => lib%get_process_def_ptr (var_str ("omega2_a"))
	config => entry%get_component_def_ptr (1)
	call prc1%init (config%get_core_def_ptr (), &
	lib, var_str ("omega2_a"), 1)
	call prc1%get_constants (data, 1)

	write (u, "(1x,A,A)") "component ID = ", &
	char (data%id)
	write (u, "(1x,A,L1)") "openmp supported = ", &
	data%openmp_supported
	write (u, "(1x,A,A,A)") "model name = '", &
	char (data%model_name), "'"

	write (u, "(A)")
	write (u, "(A)") "* Constants of omega2_a_i2:"
	write (u, "(A)")

	config => entry%get_component_def_ptr (2)
	call prc2%init (config%get_core_def_ptr (), &
	lib, var_str ("omega2_a"), 2)
	call prc2%get_constants (data, 1)

	write (u, "(1x,A,A)") "component ID = ", &
	char (data%id)
	write (u, "(1x,A,L1)") "openmp supported = ", &
	data%openmp_supported
	write (u, "(1x,A,A,A)") "model name = '", &
	char (data%model_name), "'"

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics:"
	write (u, "(A)")

	p = reshape ([ &
	1.0_cdf, 0.0_cdf, 0.0_cdf, 1.0_cdf, &
	1.0_cdf, 0.0_cdf, 0.0_cdf,-1.0_cdf, &
	1.0_cdf, 1.0_cdf, 0.0_cdf, 0.0_cdf, &
	1.0_cdf,-1.0_cdf, 0.0_cdf, 0.0_cdf &
	], [4,4])
	do i = 1, 4
	write (u, "(2x,A,I0,A,4(1x,F7.4))") "p", i, " =", p(:,i)
	end do

	write (u, "(A)")
	write (u, "(A)") "* Compute matrix element:"
	write (u, "(A)")

	select type (driver => prc1%driver)
	type is (omega_driver_t)
	call driver%new_event (p)
	call driver%get_amplitude (1_ci, 6_ci, 1_ci, amp)
	write (u, "(2x,A,1x,E11.4)") "(1) \|amp (1, 6, 1)\| =", abs (amp)
	end select

	select type (driver => prc2%driver)
	type is (omega_driver_t)
	call driver%new_event (p)
	call driver%get_amplitude (1_ci, 6_ci, 1_ci, amp)
	write (u, "(2x,A,1x,E11.4)") "(2) \|amp (1, 6, 1)\| =", abs (amp)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics:"
	write (u, "(A)")

	p = reshape ([ &
	1.0_cdf, 0.0_cdf, 0.0_cdf, 1.0_cdf, &
	1.0_cdf, 0.0_cdf, 0.0_cdf,-1.0_cdf, &
	1.0_cdf, sqrt(0.5_cdf), 0.0_cdf, sqrt(0.5_cdf), &
	1.0_cdf,-sqrt(0.5_cdf), 0.0_cdf,-sqrt(0.5_cdf) &
	], [4,4])
	do i = 1, 4
	write (u, "(2x,A,I0,A,4(1x,F7.4))") "p", i, " =", p(:,i)
	end do

	write (u, "(A)")
	write (u, "(A)") "* Compute matrix element:"
	write (u, "(A)")

	select type (driver => prc1%driver)
	type is (omega_driver_t)
	call driver%new_event (p)
	call driver%get_amplitude (1_ci, 6_ci, 1_ci, amp)
	write (u, "(2x,A,1x,E11.4)") "(1) \|amp (1, 6, 1)\| =", abs (amp)
	end select

	select type (driver => prc2%driver)
	type is (omega_driver_t)
	call driver%new_event (p)
	call driver%get_amplitude (1_ci, 6_ci, 1_ci, amp)
	write (u, "(2x,A,1x,E11.4)") "(2) \|amp (1, 6, 1)\| =", abs (amp)
	end select

	call lib%final ()
	call cleanup_model (model)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: prc_omega_2"

	end subroutine prc_omega_2

	@ %def prc_omega_2
	@
	\subsubsection{Check helicity selection}
	The process is $e^- e^+ \to e^- e^+$ for vanishing masses. We call
	the matrix element several times to verify the switching off of
	irrelevant helicities.
	<<Omega interface: execute tests>>=
	call test (prc_omega_3, "prc_omega_3", &
	"helicity selection", &
	u, results)
	<<Omega interface: test declarations>>=
	public :: prc_omega_3
	<<Omega interface: tests>>=
	subroutine prc_omega_3 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(process_def_entry_t), pointer :: entry
	type(os_data_t) :: os_data
	type(string_t) :: model_name
	class(model_data_t), pointer :: model
	class(vars_t), pointer :: vars => null ()
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(process_component_def_t), pointer :: config
	type(prc_omega_t) :: prc1
	type(process_constants_t) :: data
	integer, parameter :: cdf = c_default_float
	real(cdf), dimension(:), allocatable :: par
	real(cdf), dimension(0:3,4) :: p
	type(helicity_selection_t) :: helicity_selection
	integer :: i, h

	write (u, "(A)") "* Test output: prc_omega_3"
	write (u, "(A)") "* Purpose: create simple process with OMega"
	write (u, "(A)") "* and check helicity selection"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library."
	write (u, "(A)") "* (1) e- e+ -> e- e+ (all diagrams, no OpenMP)"

	call lib%init (var_str ("omega3"))
	call os_data%init ()

	model_name = "QED"
	model => null ()
	call prepare_model (model, model_name, vars)

	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e-"), var_str ("e+")]
	prt_out = prt_in

	allocate (entry)
	call entry%init (var_str ("omega3_a"), &
	model, n_in = 2, n_components = 1)

	call omega_make_process_component (entry, 1, &
	model_name, prt_in, prt_out)
	call lib%append (entry)

	write (u, "(A)")
	write (u, "(A)") "* Build and load library"

	call lib%configure (os_data)
	call lib%write_makefile (os_data, force = .true., verbose = .false.)
	call lib%clean (os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (os_data)

	write (u, "(A)")
	write (u, "(A)") "* Probe library API:"
	write (u, "(A)")

	write (u, "(1x,A,L1)") "is active = ", &
	lib%is_active ()
	write (u, "(1x,A,I0)") "n_processes = ", &
	lib%get_n_processes ()

	write (u, "(A)")
	write (u, "(A)") "* Set parameters for omega3_a and initialize:"
	write (u, "(A)")

	call vars%set_rval (var_str ("ee"), 0.3_default)
	call vars%set_rval (var_str ("me"), 0._default)
	call vars%set_rval (var_str ("mmu"), 0._default)
	call vars%set_rval (var_str ("mtau"), 0._default)
	allocate (par (model%get_n_real ()))
	call model%real_parameters_to_c_array (par)

	write (u, "(2x,A,F6.4)") "ee = ", par(1)
	write (u, "(2x,A,F6.4)") "me = ", par(2)
	write (u, "(2x,A,F6.4)") "mmu = ", par(3)
	write (u, "(2x,A,F6.4)") "mtau = ", par(4)

	call prc1%set_parameters (model, helicity_selection=helicity_selection)

	write (u, "(A)")
	write (u, "(A)") "* Helicity states of omega3_a_i1:"
	write (u, "(A)")

	entry => lib%get_process_def_ptr (var_str ("omega3_a"))
	config => entry%get_component_def_ptr (1)
	call prc1%init (config%get_core_def_ptr (), &
	lib, var_str ("omega3_a"), 1)
	call prc1%get_constants (data, 1)

	do i = 1, data%n_hel
	write (u, "(3x,I2,':',4(1x,I2))") i, data%hel_state(:,i)
	end do

	write (u, "(A)")
	write (u, "(A)") "* Initially allowed helicities:"
	write (u, "(A)")

	write (u, "(4x,16(1x,I2))") [(h, h = 1, data%n_hel)]
	write (u, "(4x)", advance = "no")
	do h = 1, data%n_hel
	write (u, "(2x,L1)", advance = "no") prc1%is_allowed (1, 1, h, 1)
	end do
	write (u, "(A)")

	write (u, "(A)")
	write (u, "(A)") "* Reset helicity selection (cutoff = 4)"
	write (u, "(A)")

	helicity_selection%active = .true.
	helicity_selection%threshold = 1e10_default
	helicity_selection%cutoff = 4
	call helicity_selection%write (u)

	call prc1%set_parameters (model, helicity_selection=helicity_selection)
	call prc1%reset_helicity_selection ()

	write (u, "(A)")
	write (u, "(A)") "* Allowed helicities:"
	write (u, "(A)")

	write (u, "(4x,16(1x,I2))") [(h, h = 1, data%n_hel)]
	write (u, "(4x)", advance = "no")
	do h = 1, data%n_hel
	write (u, "(2x,L1)", advance = "no") prc1%is_allowed (1, 1, h, 1)
	end do
	write (u, "(A)")

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics:"
	write (u, "(A)")

	p = reshape ([ &
	1.0_cdf, 0.0_cdf, 0.0_cdf, 1.0_cdf, &
	1.0_cdf, 0.0_cdf, 0.0_cdf,-1.0_cdf, &
	1.0_cdf, 1.0_cdf, 0.0_cdf, 0.0_cdf, &
	1.0_cdf,-1.0_cdf, 0.0_cdf, 0.0_cdf &
	], [4,4])
	do i = 1, 4
	write (u, "(2x,A,I0,A,4(1x,F7.4))") "p", i, " =", p(:,i)
	end do

	write (u, "(A)")
	write (u, "(A)") "* Compute scattering matrix 5 times"
	write (u, "(A)")

	write (u, "(4x,16(1x,I2))") [(h, h = 1, data%n_hel)]

	select type (driver => prc1%driver)
	type is (omega_driver_t)
	do i = 1, 5
	call driver%new_event (p)
	write (u, "(2x,I2)", advance = "no") i
	do h = 1, data%n_hel
	write (u, "(2x,L1)", advance = "no") prc1%is_allowed (1, 1, h, 1)
	end do
	write (u, "(A)")
	end do
	end select

	write (u, "(A)")
	write (u, "(A)") "* Reset helicity selection again"
	write (u, "(A)")

	call prc1%activate_parameters ()

	write (u, "(A)") "* Allowed helicities:"
	write (u, "(A)")

	write (u, "(4x,16(1x,I2))") [(h, h = 1, data%n_hel)]
	write (u, "(4x)", advance = "no")
	do h = 1, data%n_hel
	write (u, "(2x,L1)", advance = "no") prc1%is_allowed (1, 1, h, 1)
	end do
	write (u, "(A)")

	call lib%final ()
	call cleanup_model (model)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: prc_omega_3"

	end subroutine prc_omega_3

	@ %def prc_omega_3
	@
	\subsubsection{QCD coupling}
	The process is $u\bar u \to d\bar d$ for vanishing masses. We compute
	the amplitude for a fixed configuration once, then reset $\alpha_s$,
	then compute again.

	For [[GNU make]], [[makeflags]] is set to [[-j1]]. This eliminates a
	potential clash with a [[-j<n>]] flag if this test is called from a
	parallel make.
	<<Omega interface: execute tests>>=
	call test (prc_omega_4, "prc_omega_4", &
	"update QCD alpha", &
	u, results)
	<<Omega interface: test declarations>>=
	public :: prc_omega_4
	<<Omega interface: tests>>=
	subroutine prc_omega_4 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry
	type(os_data_t) :: os_data
	type(string_t) :: model_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(process_constants_t) :: data
	class(prc_core_driver_t), allocatable :: driver
	integer, parameter :: cdf = c_default_float
	integer, parameter :: ci = c_int
	real(cdf), dimension(8) :: par
	real(cdf), dimension(0:3,4) :: p
	logical(c_bool) :: flag
	complex(c_default_complex) :: amp
	integer :: i
	real(cdf) :: alpha_s

	write (u, "(A)") "* Test output: prc_omega_4"
	write (u, "(A)") "* Purpose: create a QCD process with OMega"
	write (u, "(A)") "* and check alpha_s dependence"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry"
	write (u, "(A)")
	call lib%init (var_str ("prc_omega_4_lib"))
	call os_data%init ()

	model_name = "QCD"
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("u"), var_str ("ubar")]
	prt_out = [var_str ("d"), var_str ("dbar")]

	allocate (omega_def_t :: def)
	select type (def)
	type is (omega_def_t)
	call def%init (model_name, prt_in, prt_out, &
	ufo = .false., ovm = .false.)
	end select
	allocate (entry)
	call entry%init (var_str ("prc_omega_4_p"), model_name = model_name, &
	n_in = 2, n_components = 1)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("omega"), &
	variant = def)
	call lib%append (entry)

	write (u, "(A)") "* Configure and compile process"
	write (u, "(A)")
	call lib%configure (os_data)
	call lib%write_makefile (os_data, force = .true., verbose = .false.)
	call lib%clean (os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (os_data)

	write (u, "(A)") "* Probe library API:"
	write (u, "(A)")

	write (u, "(1x,A,L1)") "is active = ", lib%is_active ()

	write (u, "(A)")
	write (u, "(A)") "* Set parameters:"
	write (u, "(A)")

	alpha_s = 0.1178_cdf

	par = [alpha_s, &
	0._cdf, 0._cdf, 0._cdf, 0._cdf, 0._cdf, 173.1_cdf, 1.523_cdf]
	write (u, "(2x,A,F8.4)") "alpha_s = ", par(1)
	write (u, "(2x,A,F8.4)") "md = ", par(2)
	write (u, "(2x,A,F8.4)") "mu = ", par(3)
	write (u, "(2x,A,F8.4)") "ms = ", par(4)
	write (u, "(2x,A,F8.4)") "mc = ", par(5)
	write (u, "(2x,A,F8.4)") "mb = ", par(6)
	write (u, "(2x,A,F8.4)") "mtop = ", par(7)
	write (u, "(2x,A,F8.4)") "wtop = ", par(8)

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics:"
	write (u, "(A)")

	p = reshape ([ &
	100.0_cdf, 0.0_cdf, 0.0_cdf, 100.0_cdf, &
	100.0_cdf, 0.0_cdf, 0.0_cdf,-100.0_cdf, &
	100.0_cdf, 100.0_cdf, 0.0_cdf, 0.0_cdf, &
	100.0_cdf,-100.0_cdf, 0.0_cdf, 0.0_cdf &
	], [4,4])
	do i = 1, 4
	write (u, "(2x,A,I0,A,4(1x,F7.1))") "p", i, " =", p(:,i)
	end do

	call lib%connect_process (var_str ("prc_omega_4_p"), 1, data, driver)

	select type (driver)
	type is (omega_driver_t)
	call driver%init (par, 0)

	write (u, "(A)")
	write (u, "(A)") "* Compute matrix element:"
	write (u, "(A)")

	call driver%new_event (p)

	call driver%is_allowed (1_ci, 6_ci, 1_ci, flag)
	write (u, "(1x,A,L1)") "is_allowed (1, 6, 1) = ", flag

	call driver%get_amplitude (1_ci, 6_ci, 1_ci, amp)
	write (u, "(1x,A,1x,E11.4)") "\|amp (1, 6, 1)\| =", abs (amp)

	write (u, "(A)")
	write (u, "(A)") "* Double alpha_s and compute matrix element again:"
	write (u, "(A)")

	call driver%update_alpha_s (2 * alpha_s)
	call driver%new_event (p)

	call driver%is_allowed (1_ci, 6_ci, 1_ci, flag)
	write (u, "(1x,A,L1)") "is_allowed (1, 6, 1) = ", flag

	call driver%get_amplitude (1_ci, 6_ci, 1_ci, amp)
	write (u, "(1x,A,1x,E11.4)") "\|amp (1, 6, 1)\| =", abs (amp)
	end select

	call lib%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: prc_omega_4"

	end subroutine prc_omega_4

	@ %def prc_omega_4
	@
	\subsubsection{Amplitude and QCD coupling}
	The same process as before. Here, we initialize with a running $\alpha_s$
	coupling and compute twice with different scales. We use the high-level
	method [[compute_amplitude]].
	<<Omega interface: execute tests>>=
	call test (prc_omega_5, "prc_omega_5", &
	"running QCD alpha", &
	u, results)
	<<Omega interface: test declarations>>=
	public :: prc_omega_5
	<<Omega interface: tests>>=
	subroutine prc_omega_5 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	class(prc_core_def_t), allocatable :: def
	type(process_component_def_t), pointer :: cdef_ptr
	class(prc_core_def_t), pointer :: def_ptr
	type(process_def_entry_t), pointer :: entry
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(string_t) :: model_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(qcd_t) :: qcd
	class(prc_core_t), allocatable :: core
	class(prc_core_state_t), allocatable :: core_state
	type(vector4_t), dimension(4) :: p
	complex(default) :: amp
	real(default) :: ren_scale
	real(default), allocatable :: alpha_qcd_forced
	integer :: i

	write (u, "(A)") "* Test output: prc_omega_5"
	write (u, "(A)") "* Purpose: create a QCD process with OMega"
	write (u, "(A)") "* and check alpha_s dependence"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry"
	write (u, "(A)")
	call lib%init (var_str ("prc_omega_5_lib"))
	call os_data%init ()

	model_name = "QCD"
	model => null ()
	call prepare_model (model, model_name)

	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("u"), var_str ("ubar")]
	prt_out = [var_str ("d"), var_str ("dbar")]

	allocate (omega_def_t :: def)
	select type (def)
	type is (omega_def_t)
	call def%init (model_name, prt_in, prt_out, &
	ufo = .false., ovm = .false.)
	end select
	allocate (entry)
	call entry%init (var_str ("prc_omega_5_p"), model_name = model_name, &
	n_in = 2, n_components = 1)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("omega"), &
	variant = def)
	call lib%append (entry)

	write (u, "(A)") "* Configure and compile process"
	write (u, "(A)")
	call lib%configure (os_data)
	call lib%write_makefile (os_data, force = .true., verbose = .false.)
	call lib%clean (os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (os_data)

	write (u, "(A)") "* Probe library API"
	write (u, "(A)")

	write (u, "(1x,A,L1)") "is active = ", lib%is_active ()

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics"
	write (u, "(A)")

	p(1) = vector4_moving (100._default, 100._default, 3)
	p(2) = vector4_moving (100._default,-100._default, 3)
	p(3) = vector4_moving (100._default, 100._default, 1)
	p(4) = vector4_moving (100._default,-100._default, 1)
	do i = 1, 4
	call vector4_write (p(i), u)
	end do

	write (u, "(A)")
	write (u, "(A)") "* Setup QCD data"
	write (u, "(A)")

	allocate (alpha_qcd_from_scale_t :: qcd%alpha)

	write (u, "(A)") "* Setup process core"
	write (u, "(A)")

	allocate (prc_omega_t :: core)
	entry => lib%get_process_def_ptr (var_str ("prc_omega_5_p"))
	cdef_ptr => entry%get_component_def_ptr (1)
	def_ptr => cdef_ptr%get_core_def_ptr ()

	select type (core)
	type is (prc_omega_t)
	call core%allocate_workspace (core_state)
	call core%set_parameters (model, qcd = qcd)
	call core%init (def_ptr, lib, var_str ("prc_omega_5_p"), 1)
	call core%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Compute matrix element"
	write (u, "(A)")

	ren_scale = 100
	write (u, "(1x,A,F4.0)") "renormalization scale = ", ren_scale

	amp = core%compute_amplitude &
	(1, p, 1, 6, 1, 100._default, ren_scale, alpha_qcd_forced)

	write (u, "(1x,A,1x,E11.4)") "\|amp (1, 6, 1)\| =", abs (amp)

	write (u, "(A)")
	write (u, "(A)") "* Modify renormalization scale and &
	&compute matrix element again"
	write (u, "(A)")

	ren_scale = 200
	write (u, "(1x,A,F4.0)") "renormalization scale = ", ren_scale

	amp = core%compute_amplitude &
	(1, p, 1, 6, 1, 100._default, ren_scale, alpha_qcd_forced)

	write (u, "(1x,A,1x,E11.4)") "\|amp (1, 6, 1)\| =", abs (amp)

	write (u, "(A)")
	write (u, "(A)") "* Set alpha(QCD) directly and &
	&compute matrix element again"
	write (u, "(A)")

	allocate (alpha_qcd_forced, source = 0.1_default)
	write (u, "(1x,A,F6.4)") "alpha_qcd = ", alpha_qcd_forced

	amp = core%compute_amplitude &
	(1, p, 1, 6, 1, 100._default, ren_scale, alpha_qcd_forced)

	write (u, "(1x,A,1x,E11.4)") "\|amp (1, 6, 1)\| =", abs (amp)

	end select

	call lib%final ()
	call cleanup_model (model)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: prc_omega_5"

	end subroutine prc_omega_5

	@ %def prc_omega_5
	@
	\subsubsection{UFO model file support}
	Again, the process is $e^- e^+ \to e^- e^+$ for vanishing masses and
	$e=0.3$. We build the library using the high-level procedure
	[[omega_make_process_component]] and the ``black box''
	[[prc_omega_t]] object. OMega must be able to digest the specified
	UFO file and provide use with a fresh model file that can be read
	after producing the process code.

	For [[GNU make]], [[makeflags]] is set to [[-j1]]. This eliminates a
	potential clash with a [[-j<n>]] flag if this test is called from a
	parallel make.
	<<Omega interface: execute tests>>=
	call test (prc_omega_6, "prc_omega_6", &
	"OMega UFO support", &
	u, results)
	<<Omega interface: test declarations>>=
	public :: prc_omega_6
	<<Omega interface: tests>>=
	subroutine prc_omega_6 (u)
	integer, intent(in) :: u
	type(process_library_t), target :: lib
	type(process_def_entry_t), pointer :: entry
	type(os_data_t) :: os_data
	type(string_t) :: model_name
	class(model_data_t), pointer :: model
	class(vars_t), pointer :: vars
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(string_t) :: restrictions
	type(process_component_def_t), pointer :: config
	type(prc_omega_t) :: prc1, prc2
	type(process_constants_t) :: data
	integer, parameter :: cdf = c_default_float
	integer, parameter :: ci = c_int
	real(cdf), dimension(:), allocatable :: par
	real(cdf), dimension(0:3,4) :: p
	complex(c_default_complex) :: amp
	integer :: i
	logical :: exist

	write (u, "(A)") "* Test output: prc_omega_6"
	write (u, "(A)") "* Purpose: create simple process with OMega / UFO file"
	write (u, "(A)")

	call os_data%init ()

	model_name = "SM"
	model => null ()

	os_data%whizard_modelpath_ufo = "../models/UFO"

	write (u, "(A)") "* Create process library entry"
	write (u, "(A)")

	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e-"), var_str ("e+")]
	prt_out = prt_in
	restrictions = "3+4~A"

	allocate (entry)
	call entry%init (var_str ("omega_6_a"), &
	model_name = model_name, n_in = 2, n_components = 1)

	call omega_make_process_component (entry, 1, &
	model_name, prt_in, prt_out, &
	ufo=.true., ufo_path=os_data%whizard_modelpath_ufo, &
	report_progress=.true.)

	call entry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Build and load library"

	call lib%init (var_str ("omega_6"))
	call lib%append (entry)

	call lib%configure (os_data)
	call lib%write_makefile (os_data, force = .true., verbose = .false.)
	call lib%clean (os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (os_data)

	write (u, "(A)")
	write (u, "(A)") "* Probe library API:"
	write (u, "(A)")

	write (u, "(1x,A,L1)") "is active = ", &
	lib%is_active ()
	write (u, "(1x,A,I0)") "n_processes = ", &
	lib%get_n_processes ()

	call lib%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: prc_omega_6"

	end subroutine prc_omega_6

	@ %def prc_omega_6
	@
	\subsubsection{Generate matrix element diagrams}
	The same process as before. No amplitude is computed here, instead we just
	generate Feynman (and color flow) diagrams, and check whether PS and PDF
	files have been generated. This test is only run if event analysis is
	possible.
	<<Omega interface: execute diags tests>>=
	call test (prc_omega_diags_1, "prc_omega_diags_1", &
	"generate Feynman diagrams", &
	u, results)
	<<Omega interface: test declarations>>=
	public :: prc_omega_diags_1
	<<Omega interface: tests>>=
	subroutine prc_omega_diags_1 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry
	type(os_data_t) :: os_data
	type(string_t) :: model_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(string_t) :: diags_file, pdf_file, ps_file
	logical :: exist, exist_pdf, exist_ps
	integer :: iostat, u_diags
	character(128) :: buffer

	write (u, "(A)") "* Test output: prc_omega_diags_1"
	write (u, "(A)") "* Purpose: generate Feynman diagrams"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry"
	write (u, "(A)")
	call lib%init (var_str ("prc_omega_diags_1_lib"))
	call os_data%init ()

	model_name = "SM"

	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("u"), var_str ("ubar")]
	prt_out = [var_str ("d"), var_str ("dbar")]

	allocate (omega_def_t :: def)
	select type (def)
	type is (omega_def_t)
	call def%init (model_name, prt_in, prt_out, &
	ufo = .false., ovm = .false., &
	diags = .true., diags_color = .true.)
	end select
	allocate (entry)
	call entry%init (var_str ("prc_omega_diags_1_p"), model_name = model_name, &
	n_in = 2, n_components = 1)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("omega"), &
	variant = def)
	call lib%append (entry)

	write (u, "(A)") "* Configure and compile process"
	write (u, "(A)") " and generate diagrams"
	write (u, "(A)")
	call lib%configure (os_data)
	call lib%write_makefile &
	(os_data, force = .true., verbose = .false., testflag = .true.)
	call lib%clean (os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (os_data)

	write (u, "(A)") "* Probe library API"
	write (u, "(A)")

	write (u, "(1x,A,L1)") "is active = ", lib%is_active ()

	write (u, "(A)") "* Check produced diagram files"
	write (u, "(A)")

	diags_file = "prc_omega_diags_1_p_i1_diags.tex"
	ps_file = "prc_omega_diags_1_p_i1_diags.ps"
	pdf_file = "prc_omega_diags_1_p_i1_diags.pdf"
	inquire (file = char (diags_file), exist = exist)
	if (exist) then
	u_diags = free_unit ()
	open (u_diags, file = char (diags_file), action = "read", status = "old")
	iostat = 0
	do while (iostat == 0)
	read (u_diags, "(A)", iostat = iostat) buffer
	if (iostat == 0) write (u, "(A)") trim (buffer)
	end do
	close (u_diags)
	else
	write (u, "(A)") "[Feynman diagrams LaTeX file is missing]"
	end if
	inquire (file = char (ps_file), exist = exist_ps)
	if (exist_ps) then
	write (u, "(A)") "[Feynman diagrams Postscript file exists and is nonempty]"
	else
	write (u, "(A)") "[Feynman diagrams Postscript file is missing/non-regular]"
	end if
	inquire (file = char (pdf_file), exist = exist_pdf)
	if (exist_pdf) then
	write (u, "(A)") "[Feynman diagrams PDF file exists and is nonempty]"
	else
	write (u, "(A)") "[Feynman diagrams PDF file is missing/non-regular]"
	end if

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"
	write (u, "(A)")

	call lib%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: prc_omega_diags_1"

	end subroutine prc_omega_diags_1

	@ %def prc_omega_diags_1
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{External matrix elements (squared)}
	This defines an abstract framework that can handle matrix elements which are
	computed outside of \whizard. Such matrix elements typically (i) require
	extra code or libraries to be configured linked at execution time, and (ii)
	provide only plain or correlated squared matrix elements instead of
	amplitudes.

	In particular, matrix-element libraries that conform to the BLHA standard
	belong to this class. They have their own (also abstract) extension of the
	abstract [[prc_external_t]] type introduced here.
	[[prc_external_t]]-type.
	<<[[prc_external.f90]]>>=
	<<File header>>
	module prc_external

	use, intrinsic :: iso_c_binding !NODEP!

	use kinds
	<<Use strings>>
	use constants
	use os_interface
	use lorentz
	use interactions
	use sm_qcd
	use sm_qed
	use variables, only: var_list_t

	use model_data
	use prclib_interfaces
	use prc_core_def
	use prc_core

	use sf_base
	use sf_pdf_builtin, only: pdf_builtin_t
	use sf_lhapdf, only: lhapdf_t

	<<Standard module head>>

	<<Prc external: public>>

	<<Prc external: types>>

	<<Prc external: interfaces>>

	interface
	<<Prc external: sub interfaces>>
	end interface

	contains

	<<Prc external: main procedures>>

	end module prc_external
	@ %def prc_external
	@
	<<[[prc_external_sub.f90]]>>=
	<<File header>>

	submodule (prc_external) prc_external_s

	<<Use debug>>
	use io_units
	use pdg_arrays, only: is_gluon, is_quark
	use system_defs, only: TAB
	use physics_defs, only: CF
	use diagnostics
	use prc_omega, only: omega_state_t
	!!! Intel oneAPI 2022/23 regression workaround
	use variables, only: var_list_t

	implicit none

	<<Prc external: parameters>>

	contains

	<<Prc external: procedures>>

	end submodule prc_external_s

	@ %def prc_external_s
	@
	\subsection{Handling of structure functions}
	External matrix elements do not have access to the structure functions
	stored in the evaluators. The current solution to this problem is to
	just apply them explicitly after the computation of the matrix element.
	<<Prc external: parameters>>=
	integer, parameter :: LEPTONS = 1
	integer, parameter :: HADRONS = 2
	<<Prc external: types>>=
	type :: sf_handler_t
	integer :: initial_state_type = 0
	integer :: n_sf = -1
	real(default) :: val = one
	contains
	<<Prc external: sf handler: TBP>>
	end type sf_handler_t

	@ %def sf_handler_t
	@
	<<Prc external: sf handler: TBP>>=
	procedure :: init => sf_handler_init
	<<Prc external: sub interfaces>>=
	module subroutine sf_handler_init (sf_handler, sf_chain)
	class(sf_handler_t), intent(out) :: sf_handler
	type(sf_chain_instance_t), intent(in) :: sf_chain
	end subroutine sf_handler_init
	<<Prc external: procedures>>=
	module subroutine sf_handler_init (sf_handler, sf_chain)
	class(sf_handler_t), intent(out) :: sf_handler
	type(sf_chain_instance_t), intent(in) :: sf_chain
	integer :: i
	sf_handler%n_sf = size (sf_chain%sf)
	if (sf_handler%n_sf == 0) then
	sf_handler%initial_state_type = LEPTONS
	else
	do i = 1, sf_handler%n_sf
	select type (int => sf_chain%sf(i)%int)
	type is (pdf_builtin_t)
	sf_handler%initial_state_type = HADRONS
	type is (lhapdf_t)
	sf_handler%initial_state_type = HADRONS
	class default
	sf_handler%initial_state_type = LEPTONS
	end select
	end do
	end if
	end subroutine sf_handler_init

	@ %def sf_handler_init
	@
	<<Prc external: sf handler: TBP>>=
	procedure :: init_dummy => sf_handler_init_dummy
	<<Prc external: sub interfaces>>=
	module subroutine sf_handler_init_dummy (sf_handler)
	class(sf_handler_t), intent(out) :: sf_handler
	end subroutine sf_handler_init_dummy
	<<Prc external: procedures>>=
	module subroutine sf_handler_init_dummy (sf_handler)
	class(sf_handler_t), intent(out) :: sf_handler
	sf_handler%n_sf = 0
	sf_handler%initial_state_type = LEPTONS
	end subroutine sf_handler_init_dummy

	@ %def sf_handler_init_dummy
	@
	<<Prc external: sf handler: TBP>>=
	procedure :: apply_structure_functions => &
	sf_handler_apply_structure_functions
	<<Prc external: sub interfaces>>=
	module subroutine sf_handler_apply_structure_functions &
	(sf_handler, sf_chain, flavors)
	class(sf_handler_t), intent(inout) :: sf_handler
	type(sf_chain_instance_t), intent(in) :: sf_chain
	integer, intent(in), dimension(2) :: flavors
	end subroutine sf_handler_apply_structure_functions
	<<Prc external: procedures>>=
	module subroutine sf_handler_apply_structure_functions &
	(sf_handler, sf_chain, flavors)
	class(sf_handler_t), intent(inout) :: sf_handler
	type(sf_chain_instance_t), intent(in) :: sf_chain
	integer, intent(in), dimension(2) :: flavors
	integer :: i
	real(default), dimension(:), allocatable :: f
	if (sf_handler%n_sf < 0) call msg_fatal ("sf_handler not initialized")
	sf_handler%val = one
	do i = 1, sf_handler%n_sf
	select case (sf_handler%initial_state_type)
	case (HADRONS)
	sf_handler%val = sf_handler%val * &
	sf_handler%get_pdf (sf_chain, i, flavors(i))
	case (LEPTONS)
	call sf_chain%get_matrix_elements (i, f)
	sf_handler%val = sf_handler%val * f(1)
	case default
	call msg_fatal ("sf_handler not initialized")
	end select
	end do
	end subroutine sf_handler_apply_structure_functions

	@ %def sf_handler_apply_structure_functions
	@
	<<Prc external: sf handler: TBP>>=
	procedure :: get_pdf => sf_handler_get_pdf
	<<Prc external: sub interfaces>>=
	module function sf_handler_get_pdf &
	(sf_handler, sf_chain, i, flavor) result (f)
	real(default) :: f
	class(sf_handler_t), intent(in) :: sf_handler
	type(sf_chain_instance_t), intent(in) :: sf_chain
	integer, intent(in) :: i, flavor
	end function sf_handler_get_pdf
	<<Prc external: procedures>>=
	module function sf_handler_get_pdf &
	(sf_handler, sf_chain, i, flavor) result (f)
	real(default) :: f
	class(sf_handler_t), intent(in) :: sf_handler
	type(sf_chain_instance_t), intent(in) :: sf_chain
	integer, intent(in) :: i, flavor
	integer :: k
	real(default), dimension(:), allocatable :: ff
	integer, parameter :: n_flv_light = 6

	call sf_chain%get_matrix_elements (i, ff)

	if (is_gluon (flavor)) then
	k = n_flv_light + 1
	else if (is_quark (abs(flavor))) then
	k = n_flv_light + 1 + flavor
	else
	call msg_fatal ("Not a colored particle")
	end if

	f = ff(k)
	end function sf_handler_get_pdf

	@ %def sf_handler_get_pdf
	@
	\subsection{Abstract interface to external matrix elements}
	This process class allows us to factor out common necessities of processes
	that involve external code or libraries.

	\subsubsection{Workspace}
	This is the workspace that is available for external matrix elements.
	<<Prc external: public>>=
	public :: prc_external_state_t
	<<Prc external: types>>=
	type, abstract, extends (prc_core_state_t) :: prc_external_state_t
	logical :: new_kinematics = .true.
	real(default) :: alpha_qcd = -1
	real(default) :: alpha_qed = -1
	contains
	<<Prc external: external state: TBP>>
	end type prc_external_state_t

	@ %def prc_external_state_t
	@
	<<Prc external: external state: TBP>>=
	procedure :: reset_new_kinematics => prc_external_state_reset_new_kinematics
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_state_reset_new_kinematics (object)
	class(prc_external_state_t), intent(inout) :: object
	end subroutine prc_external_state_reset_new_kinematics
	<<Prc external: procedures>>=
	module subroutine prc_external_state_reset_new_kinematics (object)
	class(prc_external_state_t), intent(inout) :: object
	object%new_kinematics = .true.
	end subroutine prc_external_state_reset_new_kinematics

	@ %def prc_external_state_reset_new_kinematics
	@
	\subsubsection{Driver}
	We have to add two O'Mega-routines to the external matrix-element driver to
	ensure proper process setup. The problem is that during the setup of
	the real component, the particle and flavor data are taken from the Born
	component to set up the subtraction terms. However, the Born component
	expects this data to be obtained from the Omega code, accessed by the
	driver.
	<<Prc external: public>>=
	public :: prc_external_driver_t
	<<Prc external: types>>=
	type, abstract, extends (prc_core_driver_t) :: prc_external_driver_t
	procedure(omega_update_alpha_s), nopass, pointer :: &
	update_alpha_s => null ()
	procedure(omega_is_allowed), nopass, pointer :: &
	is_allowed => null ()
	end type prc_external_driver_t

	@ %def prc_external_driver_t
	@
	\subsubsection{Core}
	<<Prc external: public>>=
	public :: prc_external_t
	<<Prc external: types>>=
	type, abstract, extends (prc_core_t) :: prc_external_t
	type(qcd_t) :: qcd
	type(qed_t) :: qed
	integer :: n_flv = 1
	real(default), dimension(:), allocatable :: par
	integer :: scheme = 0
	type(sf_handler_t) :: sf_handler
	real(default) :: maximum_accuracy = 10000.0
	contains
	<<Prc external: prc external: TBP>>
	end type prc_external_t

	@ %def prc_external_t
	@ By definition, this class of process-core types require extra code.
	<<Prc external: prc external: TBP>>=
	procedure, nopass :: needs_external_code => &
	prc_external_needs_external_code
	<<Prc external: sub interfaces>>=
	module function prc_external_needs_external_code () result (flag)
	logical :: flag
	end function prc_external_needs_external_code
	<<Prc external: procedures>>=
	module function prc_external_needs_external_code () result (flag)
	logical :: flag
	flag = .true.
	end function prc_external_needs_external_code

	@ %def prc_external_needs_external_code
	@
	<<Prc external: prc external: TBP>>=
	procedure :: get_n_flvs => prc_external_get_n_flvs
	<<Prc external: sub interfaces>>=
	pure module function prc_external_get_n_flvs (object, i_flv) result (n)
	integer :: n
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_flv
	end function prc_external_get_n_flvs
	<<Prc external: procedures>>=
	pure module function prc_external_get_n_flvs (object, i_flv) result (n)
	integer :: n
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_flv
	n = size (object%data%flv_state (:,i_flv))
	end function prc_external_get_n_flvs

	@ %def prc_external_get_n_flvs
	@
	<<Prc external: prc external: TBP>>=
	procedure :: get_flv_state => prc_external_get_flv_state
	<<Prc external: sub interfaces>>=
	module function prc_external_get_flv_state (object, i_flv) result (flv)
	integer, dimension(:), allocatable :: flv
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_flv
	end function prc_external_get_flv_state
	<<Prc external: procedures>>=
	module function prc_external_get_flv_state (object, i_flv) result (flv)
	integer, dimension(:), allocatable :: flv
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_flv
	allocate (flv (size (object%data%flv_state (:,i_flv))))
	flv = object%data%flv_state (:,i_flv)
	end function prc_external_get_flv_state

	@ %def prc_external_get_flv_state
	@ Return one single squared test matrix element. It is fixed to 1,
	therefore the integration output will be the phase space volume.
	<<Prc external: prc external: TBP>>=
	procedure :: compute_sqme => prc_external_compute_sqme
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_compute_sqme (object, i_flv, i_hel, p, &
	ren_scale, sqme, bad_point)
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out) :: sqme
	logical, intent(out) :: bad_point
	end subroutine prc_external_compute_sqme
	<<Prc external: procedures>>=
	module subroutine prc_external_compute_sqme (object, i_flv, i_hel, p, &
	ren_scale, sqme, bad_point)
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out) :: sqme
	logical, intent(out) :: bad_point
	sqme = one
	bad_point = .false.
	end subroutine prc_external_compute_sqme

	@ %def prc_external_compute_sqme
	@ Return an array of 4 numbers corresponding to the BLHA output convention.
	Used for testing.
	<<Prc external: prc external: TBP>>=
	procedure :: compute_sqme_virt => prc_external_compute_sqme_virt
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_compute_sqme_virt (object, i_flv, i_hel, &
	p, ren_scale, es_scale, loop_method, sqme, bad_point)
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale, es_scale
	integer, intent(in) :: loop_method
	logical, intent(out) :: bad_point
	real(default), dimension(4), intent(out) :: sqme
	end subroutine prc_external_compute_sqme_virt
	<<Prc external: procedures>>=
	module subroutine prc_external_compute_sqme_virt (object, i_flv, i_hel, &
	p, ren_scale, es_scale, loop_method, sqme, bad_point)
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale, es_scale
	integer, intent(in) :: loop_method
	logical, intent(out) :: bad_point
	real(default), dimension(4), intent(out) :: sqme
	if (debug_on) call msg_debug2 &
	(D_ME_METHODS, "prc_external_compute_sqme_virt")
	sqme(1) = 0.001_default
	sqme(2) = 0.001_default
	sqme(3) = 0.001_default
	sqme(4) = 0.0015_default
	bad_point = .false.
	end subroutine prc_external_compute_sqme_virt

	@ %def prc_external_compute_sqme_virt
	@ Also return test output for color-correlated matrix elements. We only
	give a sensible result for the processes used in the functional tests,
	which have 2 -> 2 topology. All other processes will obtain a vanishing
	dummy color-correlation. This effectively switches off the subtraction
	contributions, reproducing the real phase-space volume.
	<<Prc external: prc external: TBP>>=
	procedure :: compute_sqme_color_c => prc_external_compute_sqme_color_c
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_compute_sqme_color_c (object, i_flv, &
	i_hel, p, ren_scale, born_color_c, bad_point, born_out)
	class(prc_external_t), intent(inout) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(inout), dimension(:,:) :: born_color_c
	logical, intent(out) :: bad_point
	real(default), intent(out), optional :: born_out
	end subroutine prc_external_compute_sqme_color_c
	<<Prc external: procedures>>=
	module subroutine prc_external_compute_sqme_color_c (object, i_flv, &
	i_hel, p, ren_scale, born_color_c, bad_point, born_out)
	class(prc_external_t), intent(inout) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(inout), dimension(:,:) :: born_color_c
	logical, intent(out) :: bad_point
	real(default), intent(out), optional :: born_out
	if (debug_on) call msg_debug2 (D_ME_METHODS, "prc_external_compute_sqme_color_c")
	if (size (p) == 4) then
	if (present (born_out)) then
	born_out = 0.0015_default
	born_color_c = zero
	born_color_c(3,3) = - CF * born_out
	born_color_c(4,4) = - CF * born_out
	born_color_c(3,4) = CF * born_out
	born_color_c(4,3) = born_color_c(3,4)
	bad_point = .false.
	end if
	else
	if (present (born_out)) born_out = zero
	born_color_c = zero
	end if
	end subroutine prc_external_compute_sqme_color_c

	@ %def prc_external_compute_sqme_color_c
	@
	<<Prc external: prc external: TBP>>=
	procedure :: compute_alpha_s => prc_external_compute_alpha_s
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_compute_alpha_s &
	(object, core_state, ren_scale)
	class(prc_external_t), intent(in) :: object
	class(prc_external_state_t), intent(inout) :: core_state
	real(default), intent(in) :: ren_scale
	end subroutine prc_external_compute_alpha_s
	<<Prc external: procedures>>=
	module subroutine prc_external_compute_alpha_s &
	(object, core_state, ren_scale)
	class(prc_external_t), intent(in) :: object
	class(prc_external_state_t), intent(inout) :: core_state
	real(default), intent(in) :: ren_scale
	core_state%alpha_qcd = object%qcd%alpha%get (ren_scale)
	end subroutine prc_external_compute_alpha_s

	@ %def prc_external_compute_alpha_s
	@
	<<Prc external: prc external: TBP>>=
	procedure :: get_alpha_s => prc_external_get_alpha_s
	<<Prc external: sub interfaces>>=
	module function prc_external_get_alpha_s &
	(object, core_state) result (alpha_qcd)
	class(prc_external_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qcd
	end function prc_external_get_alpha_s
	<<Prc external: procedures>>=
	module function prc_external_get_alpha_s &
	(object, core_state) result (alpha_qcd)
	class(prc_external_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qcd
	if (allocated (core_state)) then
	select type (core_state)
	class is (prc_external_state_t)
	alpha_qcd = core_state%alpha_qcd
	type is (omega_state_t)
	alpha_qcd = core_state%alpha_qcd
	class default
	alpha_qcd = zero
	end select
	else
	alpha_qcd = zero
	end if
	end function prc_external_get_alpha_s

	@ %def prc_external_get_alpha_s
	@ Getter for [[alpha_qed]]
	<<Prc external: prc external: TBP>>=
	procedure :: get_alpha_qed => prc_external_get_alpha_qed
	<<Prc external: sub interfaces>>=
	module function prc_external_get_alpha_qed &
	(object, core_state) result (alpha_qed)
	class(prc_external_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qed
	end function prc_external_get_alpha_qed
	<<Prc external: procedures>>=
	module function prc_external_get_alpha_qed &
	(object, core_state) result (alpha_qed)
	class(prc_external_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qed
	if (allocated (core_state)) then
	select type (core_state)
	class is (prc_external_state_t)
	alpha_qed = core_state%alpha_qed
	type is (omega_state_t)
	alpha_qed = core_state%alpha_qed
	class default
	alpha_qed = zero
	end select
	else
	alpha_qed = zero
	end if
	end function prc_external_get_alpha_qed

	@ %def prc_external_get_alpha_qed
	@
	<<Prc external: prc external: TBP>>=
	procedure :: is_allowed => prc_external_is_allowed
	<<Prc external: sub interfaces>>=
	module function prc_external_is_allowed &
	(object, i_term, f, h, c) result (flag)
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_term, f, h, c
	logical :: flag
	end function prc_external_is_allowed
	<<Prc external: procedures>>=
	module function prc_external_is_allowed &
	(object, i_term, f, h, c) result (flag)
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_term, f, h, c
	logical :: flag
	logical(c_bool) :: cflag
	select type (driver => object%driver)
	class is (prc_external_driver_t)
	call driver%is_allowed (f, h, c, cflag)
	flag = cflag
	class default
	call msg_fatal &
	("Driver does not fit to prc_external_t")
	end select
	end function prc_external_is_allowed

	@
	@ %def prc_external_is_allowed
	<<Prc external: prc external: TBP>>=
	procedure :: get_nflv => prc_external_get_nflv
	<<Prc external: sub interfaces>>=
	module function prc_external_get_nflv (object) result (n_flv)
	class(prc_external_t), intent(in) :: object
	integer :: n_flv
	end function prc_external_get_nflv
	<<Prc external: procedures>>=
	module function prc_external_get_nflv (object) result (n_flv)
	class(prc_external_t), intent(in) :: object
	integer :: n_flv
	n_flv = object%n_flv
	end function prc_external_get_nflv

	@ %def prc_external_get_nflv
	@
	<<Prc external: prc external: TBP>>=
	procedure :: compute_hard_kinematics => prc_external_compute_hard_kinematics
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_compute_hard_kinematics &
	(object, p_seed, i_term, int_hard, core_state)
	class(prc_external_t), intent(in) :: object
	type(vector4_t), dimension(:), intent(in) :: p_seed
	integer, intent(in) :: i_term
	type(interaction_t), intent(inout) :: int_hard
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_external_compute_hard_kinematics
	<<Prc external: procedures>>=
	module subroutine prc_external_compute_hard_kinematics &
	(object, p_seed, i_term, int_hard, core_state)
	class(prc_external_t), intent(in) :: object
	type(vector4_t), dimension(:), intent(in) :: p_seed
	integer, intent(in) :: i_term
	type(interaction_t), intent(inout) :: int_hard
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	call int_hard%set_momenta (p_seed)
	if (allocated (core_state)) then
	select type (core_state)
	class is (prc_external_state_t); core_state%new_kinematics = .true.
	end select
	end if
	end subroutine prc_external_compute_hard_kinematics

	@
	@ %def prc_external_compute_hard_kinematics
	<<Prc external: prc external: TBP>>=
	procedure :: compute_eff_kinematics => prc_external_compute_eff_kinematics
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_compute_eff_kinematics &
	(object, i_term, int_hard, int_eff, core_state)
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_term
	type(interaction_t), intent(in) :: int_hard
	type(interaction_t), intent(inout) :: int_eff
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_external_compute_eff_kinematics
	<<Prc external: procedures>>=
	module subroutine prc_external_compute_eff_kinematics &
	(object, i_term, int_hard, int_eff, core_state)
	class(prc_external_t), intent(in) :: object
	integer, intent(in) :: i_term
	type(interaction_t), intent(in) :: int_hard
	type(interaction_t), intent(inout) :: int_eff
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	end subroutine prc_external_compute_eff_kinematics

	@ %def prc_external_compute_eff_kinematics
	@ Gfortran 7/8/9 bug, has to remain in the main module.
	<<Prc external: prc external: TBP>>=
	procedure :: set_parameters => prc_external_set_parameters
	<<Prc external: main procedures>>=
	subroutine prc_external_set_parameters (object, qcd, model)
	class(prc_external_t), intent(inout) :: object
	type(qcd_t), intent(in) :: qcd
	type(qed_t) :: qed
	class(model_data_t), intent(in), target, optional :: model
	object%qcd = qcd
	if (present (model)) then
	if (.not. allocated (object%par)) &
	allocate (object%par (model%get_n_real ()))
	call model%real_parameters_to_array (object%par)
	object%scheme = model%get_scheme_num ()
	if (associated (model%get_par_data_ptr (var_str ('alpha_em_i')))) then
	allocate (alpha_qed_fixed_t :: qed%alpha)
	select type (alpha => qed%alpha)
	type is (alpha_qed_fixed_t)
	alpha%val = one / model%get_real (var_str ('alpha_em_i'))
	end select
	end if
	object%qed = qed
	end if
	end subroutine prc_external_set_parameters

	@ %def prc_external_set_parameters
	@
	<<Prc external: prc external: TBP>>=
	procedure :: update_alpha_s => prc_external_update_alpha_s
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_update_alpha_s (object, core_state, scale)
	class(prc_external_t), intent(in) :: object
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	real(default), intent(in) :: scale
	end subroutine prc_external_update_alpha_s
	<<Prc external: procedures>>=
	module subroutine prc_external_update_alpha_s (object, core_state, scale)
	class(prc_external_t), intent(in) :: object
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	real(default), intent(in) :: scale
	real(default) :: alpha_qcd
	if (allocated (object%qcd%alpha)) then
	alpha_qcd = object%qcd%alpha%get (scale)
	select type (driver => object%driver)
	class is (prc_external_driver_t)
	call driver%update_alpha_s (alpha_qcd)
	end select
	select type (core_state)
	class is (prc_external_state_t)
	core_state%alpha_qcd = alpha_qcd
	type is (omega_state_t)
	core_state%alpha_qcd = alpha_qcd
	end select
	end if
	end subroutine prc_external_update_alpha_s

	@ %def prc_external_update_alpha_s
	@
	<<Prc external: prc external: TBP>>=
	procedure :: init_sf_handler => prc_external_init_sf_handler
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_init_sf_handler (core, sf_chain)
	class(prc_external_t), intent(inout) :: core
	type(sf_chain_instance_t), intent(in) :: sf_chain
	end subroutine prc_external_init_sf_handler
	<<Prc external: procedures>>=
	module subroutine prc_external_init_sf_handler (core, sf_chain)
	class(prc_external_t), intent(inout) :: core
	type(sf_chain_instance_t), intent(in) :: sf_chain
	if (allocated (sf_chain%sf)) then
	call core%sf_handler%init (sf_chain)
	else
	call core%sf_handler%init_dummy ()
	end if
	end subroutine prc_external_init_sf_handler

	@ %def prc_external_init_sf_handler
	@
	<<Prc external: prc external: TBP>>=
	procedure :: init_sf_handler_dummy => prc_external_init_sf_handler_dummy
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_init_sf_handler_dummy (core)
	class(prc_external_t), intent(inout) :: core
	end subroutine prc_external_init_sf_handler_dummy
	<<Prc external: procedures>>=
	module subroutine prc_external_init_sf_handler_dummy (core)
	class(prc_external_t), intent(inout) :: core
	call core%sf_handler%init_dummy ()
	end subroutine prc_external_init_sf_handler_dummy

	@ %def prc_external_init_sf_handler_dummy
	@
	<<Prc external: prc external: TBP>>=
	procedure :: apply_structure_functions => &
	prc_external_apply_structure_functions
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_apply_structure_functions &
	(core, sf_chain, flavors)
	class(prc_external_t), intent(inout) :: core
	type(sf_chain_instance_t), intent(in) :: sf_chain
	integer, dimension(2), intent(in) :: flavors
	end subroutine prc_external_apply_structure_functions
	<<Prc external: procedures>>=
	module subroutine prc_external_apply_structure_functions &
	(core, sf_chain, flavors)
	class(prc_external_t), intent(inout) :: core
	type(sf_chain_instance_t), intent(in) :: sf_chain
	integer, dimension(2), intent(in) :: flavors
	call core%sf_handler%apply_structure_functions (sf_chain, flavors)
	end subroutine prc_external_apply_structure_functions

	@ %def prc_external_apply_structure_functions
	@
	<<Prc external: prc external: TBP>>=
	procedure :: get_sf_value => prc_external_get_sf_value
	<<Prc external: sub interfaces>>=
	module function prc_external_get_sf_value (core) result (val)
	real(default) :: val
	class(prc_external_t), intent(in) :: core
	end function prc_external_get_sf_value
	<<Prc external: procedures>>=
	module function prc_external_get_sf_value (core) result (val)
	real(default) :: val
	class(prc_external_t), intent(in) :: core
	val = core%sf_handler%val
	end function prc_external_get_sf_value

	@ %def prc_external_get_sf_value
	@
	<<Prc external: prc external: TBP>>=
	procedure(prc_external_includes_polarization), deferred :: &
	includes_polarization
	<<Prc external: interfaces>>=
	abstract interface
	function prc_external_includes_polarization (object) result (polarized)
	import
	logical :: polarized
	class(prc_external_t), intent(in) :: object
	end function prc_external_includes_polarization
	end interface

	@ %def prc_external_includes_polarization
	@
	\subsubsection{Configuration}
	This is the abstract external matrix-element interface.
	<<Prc external: public>>=
	public :: prc_external_def_t
	<<Prc external: types>>=
	type, abstract, extends (prc_core_def_t) :: prc_external_def_t
	type(string_t) :: basename
	contains
	<<Prc external: external def: TBP>>
	end type prc_external_def_t

	@ %def prc_external_def_t
	@
	<<Prc external: external def: TBP>>=
	procedure :: set_active_writer => prc_external_def_set_active_writer
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_def_set_active_writer (def, active)
	class(prc_external_def_t), intent(inout) :: def
	logical, intent(in) :: active
	end subroutine prc_external_def_set_active_writer
	<<Prc external: procedures>>=
	module subroutine prc_external_def_set_active_writer (def, active)
	class(prc_external_def_t), intent(inout) :: def
	logical, intent(in) :: active
	select type (writer => def%writer)
	class is (prc_external_writer_t)
	writer%active = active
	end select
	end subroutine prc_external_def_set_active_writer

	@ %def_prc_external_def_set_active_writer
	@
	<<Prc external: external def: TBP>>=
	procedure, nopass :: get_features => prc_external_def_get_features
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_def_get_features (features)
	type(string_t), dimension(:), allocatable, intent(out) :: features
	end subroutine prc_external_def_get_features
	<<Prc external: procedures>>=
	module subroutine prc_external_def_get_features (features)
	type(string_t), dimension(:), allocatable, intent(out) :: features
	allocate (features (6))
	features = [ &
	var_str ("init"), &
	var_str ("update_alpha_s"), &
	var_str ("reset_helicity_selection"), &
	var_str ("is_allowed"), &
	var_str ("new_event"), &
	var_str ("get_amplitude")]
	end subroutine prc_external_def_get_features

	@
	@ %def prc_external_def_get_features
	<<Prc external: external def: TBP>>=
	procedure :: connect => prc_external_def_connect
	procedure :: omega_connect => prc_external_def_connect
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_def_connect (def, lib_driver, i, proc_driver)
	class(prc_external_def_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	end subroutine prc_external_def_connect
	<<Prc external: procedures>>=
	module subroutine prc_external_def_connect (def, lib_driver, i, proc_driver)
	class(prc_external_def_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	integer :: pid, fid
	type(c_funptr) :: fptr
	select type (proc_driver)
	class is (prc_external_driver_t)
	pid = i
	fid = 2
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%update_alpha_s)
	fid = 4
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%is_allowed)
	end select
	end subroutine prc_external_def_connect

	@ %def prc_external_def_connect
	@
	<<Prc external: external def: TBP>>=
	procedure, nopass :: needs_code => prc_external_def_needs_code
	<<Prc external: sub interfaces>>=
	module function prc_external_def_needs_code () result (flag)
	logical :: flag
	end function prc_external_def_needs_code
	<<Prc external: procedures>>=
	module function prc_external_def_needs_code () result (flag)
	logical :: flag
	flag = .true.
	end function prc_external_def_needs_code

	@ %def prc_external_def_needs_code
	@
	<<Prc external: interfaces>>=
	abstract interface
	subroutine omega_update_alpha_s (alpha_s) bind(C)
	import
	real(c_default_float), intent(in) :: alpha_s
	end subroutine omega_update_alpha_s
	end interface

	abstract interface
	subroutine omega_is_allowed (flv, hel, col, flag) bind(C)
	import
	integer(c_int), intent(in) :: flv, hel, col
	logical(c_bool), intent(out) :: flag
	end subroutine omega_is_allowed
	end interface

	@ %def omega-interfaces
	@
	\subsubsection{Writer}
	<<Prc external: public>>=
	public :: prc_external_writer_t
	<<Prc external: types>>=
	type, abstract, extends (prc_writer_f_module_t) :: prc_external_writer_t
	type(string_t) :: model_name
	type(string_t) :: process_mode
	type(string_t) :: process_string
	type(string_t) :: restrictions
	+ type(string_t) :: ufo_path
	integer :: n_in = 0
	integer :: n_out = 0
	logical :: active = .true.
	logical :: amp_triv = .true.
	+ logical :: ufo = .false.
	contains
	<<Prc external: external writer: TBP>>
	end type prc_external_writer_t

	@ %def prc_external_writer_t
	@
	<<Prc external: external writer: TBP>>=
	procedure :: init => prc_external_writer_init
	procedure :: base_init => prc_external_writer_init
	<<Prc external: sub interfaces>>=
	pure module subroutine prc_external_writer_init &
	- (writer, model_name, prt_in, prt_out, restrictions)
	+ (writer, model_name, prt_in, prt_out, ufo, ufo_path, restrictions)
	class(prc_external_writer_t), intent(inout) :: writer
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in, prt_out
	+ logical, intent(in), optional :: ufo
	+ type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	end subroutine prc_external_writer_init
	<<Prc external: procedures>>=
	pure module subroutine prc_external_writer_init &
	- (writer, model_name, prt_in, prt_out, restrictions)
	+ (writer, model_name, prt_in, prt_out, ufo, ufo_path, restrictions)
	class(prc_external_writer_t), intent(inout) :: writer
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in, prt_out
	+ logical, intent(in), optional :: ufo
	+ type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	integer :: i
	writer%model_name = model_name
	if (present (restrictions)) then
	writer%restrictions = restrictions
	else
	writer%restrictions = ""
	end if
	+ if (present (ufo)) then
	+ writer%ufo = ufo
	+ writer%ufo_path = ufo_path
	+ else
	+ writer%ufo_path = ""
	+ end if
	writer%n_in = size (prt_in)
	writer%n_out = size (prt_out)
	select case (size (prt_in))
	case(1); writer%process_mode = " -decay"
	case(2); writer%process_mode = " -scatter"
	end select
	associate (s => writer%process_string)
	s = " '"
	do i = 1, size (prt_in)
	if (i > 1) s = s // " "
	s = s // prt_in(i)
	end do
	s = s // " ->"
	do i = 1, size (prt_out)
	s = s // " " // prt_out(i)
	end do
	s = s // "'"
	end associate
	end subroutine prc_external_writer_init

	@ %def prc_external_writer_init
	@
	<<Prc external: external writer: TBP>>=
	procedure, nopass :: get_module_name => prc_external_writer_get_module_name
	<<Prc external: sub interfaces>>=
	module function prc_external_writer_get_module_name (id) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: id
	end function prc_external_writer_get_module_name
	<<Prc external: procedures>>=
	module function prc_external_writer_get_module_name (id) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: id
	name = "opr_" // id
	end function prc_external_writer_get_module_name

	@ %def prc_external_writer_get_module_name
	@
	<<Prc external: external writer: TBP>>=
	procedure :: write_wrapper => prc_external_writer_write_wrapper
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_writer_write_wrapper &
	(writer, unit, id, feature)
	class(prc_external_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	end subroutine prc_external_writer_write_wrapper
	<<Prc external: procedures>>=
	module subroutine prc_external_writer_write_wrapper &
	(writer, unit, id, feature)
	class(prc_external_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	type(string_t) :: name
	name = writer%get_c_procname (id, feature)
	write (unit, *)
	select case (char (feature))
	case ("init")
	write (unit, "(9A)") "subroutine ", char (name), &
	" (par, scheme) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	write (unit, "(2x,9A)") "real(c_default_float), dimension(*), &
	&intent(in) :: par"
	write (unit, "(2x,9A)") "integer(c_int), intent(in) :: scheme"
	if (c_default_float == default .and. c_int == kind (1)) then
	write (unit, "(2x,9A)") "call ", char (feature), " (par, scheme)"
	end if
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("update_alpha_s")
	write (unit, "(9A)") "subroutine ", char (name), " (alpha_s) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	if (c_default_float == default) then
	write (unit, "(2x,9A)") "real(c_default_float), intent(in) &
	&:: alpha_s"
	write (unit, "(2x,9A)") "call ", char (feature), " (alpha_s)"
	end if
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("reset_helicity_selection")
	write (unit, "(9A)") "subroutine ", char (name), &
	" (threshold, cutoff) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	if (c_default_float == default) then
	write (unit, "(2x,9A)") "real(c_default_float), intent(in) &
	&:: threshold"
	write (unit, "(2x,9A)") "integer(c_int), intent(in) :: cutoff"
	write (unit, "(2x,9A)") "call ", char (feature), &
	" (threshold, int (cutoff))"
	end if
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("is_allowed")
	write (unit, "(9A)") "subroutine ", char (name), &
	" (flv, hel, col, flag) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	write (unit, "(2x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(2x,9A)") "logical(c_bool), intent(out) :: flag"
	write (unit, "(2x,9A)") "flag = ", char (feature), &
	" (int (flv), int (hel), int (col))"
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("new_event")
	write (unit, "(9A)") "subroutine ", char (name), " (p) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	if (c_default_float == default) then
	write (unit, "(2x,9A)") "real(c_default_float), dimension(0:3,*), &
	&intent(in) :: p"
	write (unit, "(2x,9A)") "call ", char (feature), " (p)"
	end if
	write (unit, "(9A)") "end subroutine ", char (name)
	case ("get_amplitude")
	write (unit, "(9A)") "subroutine ", char (name), &
	" (flv, hel, col, amp) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use kinds"
	write (unit, "(2x,9A)") "use opr_", char (id)
	write (unit, "(2x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(2x,9A)") "complex(c_default_complex), intent(out) &
	&:: amp"
	write (unit, "(2x,9A)") "amp = ", char (feature), &
	" (int (flv), int (hel), int (col))"
	write (unit, "(9A)") "end subroutine ", char (name)
	end select

	end subroutine prc_external_writer_write_wrapper

	@
	@ %def prc_external_writer_write_wrapper
	<<Prc external: external writer: TBP>>=
	procedure :: write_interface => prc_external_writer_write_interface
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_writer_write_interface &
	(writer, unit, id, feature)
	class(prc_external_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(string_t), intent(in) :: feature
	end subroutine prc_external_writer_write_interface
	<<Prc external: procedures>>=
	module subroutine prc_external_writer_write_interface &
	(writer, unit, id, feature)
	class(prc_external_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(string_t), intent(in) :: feature
	type(string_t) :: name
	name = writer%get_c_procname (id, feature)
	write (unit, "(2x,9A)") "interface"
	select case (char (feature))
	case ("init")
	write (unit, "(5x,9A)") "subroutine ", char (name), &
	" (par, scheme) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "real(c_default_float), dimension(*), &
	&intent(in) :: par"
	write (unit, "(7x,9A)") "integer(c_int), intent(in) :: scheme"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("update_alpha_s")
	write (unit, "(5x,9A)") "subroutine ", char (name), " (alpha_s) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "real(c_default_float), intent(in) :: alpha_s"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("reset_helicity_selection")
	write (unit, "(5x,9A)") "subroutine ", char (name), " &
	&(threshold, cutoff) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "real(c_default_float), intent(in) :: threshold"
	write (unit, "(7x,9A)") "integer(c_int), intent(in) :: cutoff"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("is_allowed")
	write (unit, "(5x,9A)") "subroutine ", char (name), " &
	&(flv, hel, col, flag) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(7x,9A)") "logical(c_bool), intent(out) :: flag"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("new_event")
	write (unit, "(5x,9A)") "subroutine ", char (name), " (p) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "real(c_default_float), dimension(0:3,*), &
	&intent(in) :: p"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	case ("get_amplitude")
	write (unit, "(5x,9A)") "subroutine ", char (name), " &
	&(flv, hel, col, amp) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "integer(c_int), intent(in) :: flv, hel, col"
	write (unit, "(7x,9A)") "complex(c_default_complex), intent(out) &
	&:: amp"
	write (unit, "(5x,9A)") "end subroutine ", char (name)
	end select
	write (unit, "(2x,9A)") "end interface"
	end subroutine prc_external_writer_write_interface

	@ %def prc_external_writer_write_interface
	@ Empty, but can be overridden.
	<<Prc external: external writer: TBP>>=
	procedure :: write_source_code => prc_external_writer_write_source_code
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_writer_write_source_code (writer, id)
	class(prc_external_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine prc_external_writer_write_source_code
	<<Prc external: procedures>>=
	module subroutine prc_external_writer_write_source_code (writer, id)
	class(prc_external_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	if (debug_on) call msg_debug (D_ME_METHODS, &
	"prc_external_writer_write_source_code (no-op)")
	!!! This is a dummy
	end subroutine prc_external_writer_write_source_code

	@ %def prc_external_writer_write_source_code
	@ Empty, but can be overridden.
	<<Prc external: external writer: TBP>>=
	procedure :: before_compile => prc_external_writer_before_compile
	procedure :: after_compile => prc_external_writer_after_compile
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_writer_before_compile (writer, id)
	class(prc_external_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine prc_external_writer_before_compile
	module subroutine prc_external_writer_after_compile (writer, id)
	class(prc_external_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine prc_external_writer_after_compile
	<<Prc external: procedures>>=
	module subroutine prc_external_writer_before_compile (writer, id)
	class(prc_external_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	if (debug_on) call msg_debug (D_ME_METHODS, &
	"prc_external_writer_before_compile (no-op)")
	!!! This is a dummy
	end subroutine prc_external_writer_before_compile

	module subroutine prc_external_writer_after_compile (writer, id)
	class(prc_external_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	if (debug_on) call msg_debug (D_ME_METHODS, &
	"prc_external_writer_after_compile (no-op)")
	!!! This is a dummy
	end subroutine prc_external_writer_after_compile

	@ %def prc_external_writer_before_compile
	@ %def prc_external_writer_after_compile
	@ Standard Makefile, set up to call \oMega. Additionally, the \oMega\ output
	can be exploited for its data-management parts.
	<<Prc external: external writer: TBP>>=
	procedure :: write_makefile_code => prc_external_writer_write_makefile_code
	procedure :: base_write_makefile_code => &
	prc_external_writer_write_makefile_code
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_writer_write_makefile_code &
	(writer, unit, id, os_data, verbose, testflag)
	class(prc_external_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	end subroutine prc_external_writer_write_makefile_code
	<<Prc external: procedures>>=
	module subroutine prc_external_writer_write_makefile_code &
	(writer, unit, id, os_data, verbose, testflag)
	class(prc_external_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	type(string_t) :: omega_binary, omega_path
	type(string_t) :: restrictions_string, amp_triv_string
	- omega_binary = "omega_" // writer%model_name // ".opt"
	+ type(string_t) :: parameter_module
	+ if (writer%ufo) then
	+ omega_binary = "omega_UFO.opt"
	+ else
	+ omega_binary = "omega_" // writer%model_name // ".opt"
	+ end if
	omega_path = os_data%whizard_omega_binpath // "/" // omega_binary
	if (.not. verbose) omega_path = "@" // omega_path
	if (writer%restrictions /= "") then
	restrictions_string = " -cascade '" // writer%restrictions // "'"
	else
	restrictions_string = ""
	end if
	amp_triv_string = ""
	if (writer%amp_triv) amp_triv_string = " -target:amp_triv"
	write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
	write (unit, "(5A)") char (id), ".f90:"
	- if (.not. verbose) then
	- write (unit, "(5A)") TAB // '@echo " OMEGA ', trim (char (id)), '.f90"'
	+ if (writer%ufo) then
	+ parameter_module = char (id) // "_par_" // replace (char (writer%model_name), &
	+ "-", "_", every=.true.)
	+ write (unit, "(5A)") char (id), ".f90: ", char (parameter_module), ".lo"
	+ if (.not. verbose) then
	+ write (unit, "(5A)") TAB // '@echo " OMEGA[UFO]', trim (char (id)), '.f90"'
	+ end if
	+ write (unit, "(99A)") TAB, char (omega_path), &
	+ " -o ", char (id), ".f90", &
	+ " -model:UFO_dir ", &
	+ char (writer%ufo_path), "/", char (writer%model_name), &
	+ " -model:exec", &
	+ " -target:whizard", char (amp_triv_string), &
	+ " -target:parameter_module ", char (parameter_module), &
	+ " -target:module opr_", char (id), &
	+ " -target:md5sum '", writer%md5sum, "'", &
	+ char (writer%process_mode), char (writer%process_string), &
	+ char (restrictions_string)
	+ write (unit, "(5A)") "SOURCES += ", char (parameter_module), ".f90"
	+ write (unit, "(5A)") "OBJECTS += ", char (parameter_module), ".lo"
	+ write (unit, "(5A)") char (parameter_module), ".f90:"
	+ write (unit, "(99A)") TAB, char (omega_path), &
	+ " -model:UFO_dir ", &
	+ char (writer%ufo_path), "/", char (writer%model_name), &
	+ " -model:exec", &
	+ " -target:parameter_module ", char (parameter_module), &
	+ " -params", &
	+ " -o $@"
	+ write (unit, "(5A)") char (parameter_module), ".lo: ", char (parameter_module), ".f90"
	+ if (.not. verbose) then
	+ write (unit, "(5A)") TAB // '@echo " FC " $@'
	+ end if
	+ write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"
	+ else
	+ if (.not. verbose) then
	+ write (unit, "(5A)") TAB // '@echo " OMEGA ', trim (char (id)), '.f90"'
	+ end if
	+ write (unit, "(99A)") TAB, char (omega_path), &
	+ " -o ", char (id), ".f90", &
	+ " -target:whizard", char (amp_triv_string), &
	+ " -target:parameter_module parameters_", char (writer%model_name), &
	+ " -target:module opr_", char (id), &
	+ " -target:md5sum '", writer%md5sum, "'", &
	+ char (writer%process_mode), char (writer%process_string), &
	+ char (restrictions_string)
	end if
	- write (unit, "(99A)") TAB, char (omega_path), &
	- " -o ", char (id), ".f90", &
	- " -target:whizard", char (amp_triv_string), &
	- " -target:parameter_module parameters_", char (writer%model_name), &
	- " -target:module opr_", char (id), &
	- " -target:md5sum '", writer%md5sum, "'", &
	- char (writer%process_mode), char (writer%process_string), &
	- char (restrictions_string)
	write (unit, "(5A)") "clean-", char (id), ":"
	write (unit, "(5A)") TAB, "rm -f ", char (id), ".f90"
	write (unit, "(5A)") TAB, "rm -f opr_", char (id), ".mod"
	write (unit, "(5A)") TAB, "rm -f ", char (id), ".lo"
	write (unit, "(5A)") "CLEAN_SOURCES += ", char (id), ".f90"
	write (unit, "(5A)") "CLEAN_OBJECTS += opr_", char (id), ".mod"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), ".lo"
	write (unit, "(5A)") char (id), ".lo: ", char (id), ".f90"
	if (.not. verbose) then
	write (unit, "(5A)") TAB // '@echo " FC " $@'
	end if
	write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"

	end subroutine prc_external_writer_write_makefile_code

	@ %def prc_external_writer_write_makefile_code
	@
	<<Prc external: external writer: TBP>>=
	procedure, nopass:: get_procname => prc_external_writer_writer_get_procname
	<<Prc external: sub interfaces>>=
	module function prc_external_writer_writer_get_procname &
	(feature) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: feature
	end function prc_external_writer_writer_get_procname
	<<Prc external: procedures>>=
	module function prc_external_writer_writer_get_procname &
	(feature) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: feature
	select case (char (feature))
	case ("n_in"); name = "number_particles_in"
	case ("n_out"); name = "number_particles_out"
	case ("n_flv"); name = "number_flavor_states"
	case ("n_hel"); name = "number_spin_states"
	case ("n_col"); name = "number_color_flows"
	case ("n_cin"); name = "number_color_indices"
	case ("n_cf"); name = "number_color_factors"
	case ("flv_state"); name = "flavor_states"
	case ("hel_state"); name = "spin_states"
	case ("col_state"); name = "color_flows"
	case default
	name = feature
	end select
	end function prc_external_writer_writer_get_procname

	@ %def prc_external_writer_writer_get_procname
	@
	\subsection{external test}
	\subsubsection{Writer}
	<<Prc external: public>>=
	public :: prc_external_test_writer_t
	<<Prc external: types>>=
	type, extends (prc_external_writer_t) :: prc_external_test_writer_t
	contains
	<<Prc external: external test writer: TBP>>
	end type prc_external_test_writer_t

	@ %def prc_external_test_writer_t
	@
	<<Prc external: external test writer: TBP>>=
	procedure, nopass :: type_name => prc_external_test_writer_type_name
	<<Prc external: sub interfaces>>=
	module function prc_external_test_writer_type_name () result (string)
	type(string_t) :: string
	end function prc_external_test_writer_type_name
	<<Prc external: procedures>>=
	module function prc_external_test_writer_type_name () result (string)
	type(string_t) :: string
	string = "External matrix element dummy"
	end function prc_external_test_writer_type_name

	@ %def prc_external_test_writer_type_name
	@
	\subsubsection{Workspace}
	This looks pretty useless. Why don't we make [[prc_external_state_t]]
	nonabstract and remove this?
	<<Prc external: public>>=
	public :: prc_external_test_state_t
	<<Prc external: types>>=
	type, extends (prc_external_state_t) :: prc_external_test_state_t
	contains
	<<Prc external: external test state: TBP>>
	end type prc_external_test_state_t

	@ %def prc_external_test_state_t
	@
	<<Prc external: external test state: TBP>>=
	procedure :: write => prc_external_test_state_write
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_test_state_write (object, unit)
	class(prc_external_test_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_external_test_state_write
	<<Prc external: procedures>>=
	module subroutine prc_external_test_state_write (object, unit)
	class(prc_external_test_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_external_test_state_write

	@ %def prc_external_test_state_write
	@
	\subsubsection{Driver}
	<<Prc external: public>>=
	public :: prc_external_test_driver_t
	<<Prc external: types>>=
	type, extends (prc_external_driver_t) :: prc_external_test_driver_t
	contains
	<<Prc external: external test driver: TBP>>
	end type prc_external_test_driver_t

	@ %def prc_external_test_driver_t
	@
	<<Prc external: external test driver: TBP>>=
	procedure, nopass :: type_name => prc_external_test_driver_type_name
	<<Prc external: sub interfaces>>=
	module function prc_external_test_driver_type_name () result (type)
	type(string_t) :: type
	end function prc_external_test_driver_type_name
	<<Prc external: procedures>>=
	module function prc_external_test_driver_type_name () result (type)
	type(string_t) :: type
	type = "External matrix element dummy"
	end function prc_external_test_driver_type_name

	@ %def prc_external_test_driver_type_name
	@
	\subsubsection{Configuration}
	A external test definition.
	<<Prc external: public>>=
	public :: prc_external_test_def_t
	<<Prc external: types>>=
	type, extends (prc_external_def_t) :: prc_external_test_def_t
	contains
	<<Prc external: external test def: TBP>>
	end type prc_external_test_def_t

	@ %def prc_external_test_def_t
	@ Gfortran 7/8/9 bug, has to remain in the main module.
	<<Prc external: external test def: TBP>>=
	procedure :: init => prc_external_test_def_init
	<<Prc external: main procedures>>=
	subroutine prc_external_test_def_init (object, basename, model_name, &
	prt_in, prt_out)
	class(prc_external_test_def_t), intent(inout) :: object
	type(string_t), intent(in) :: basename, model_name
	type(string_t), dimension(:), intent(in) :: prt_in, prt_out
	object%basename = basename
	allocate (prc_external_test_writer_t :: object%writer)
	select type (writer => object%writer)
	type is (prc_external_test_writer_t)
	call writer%init (model_name, prt_in, prt_out)
	end select
	end subroutine prc_external_test_def_init

	@ %def prc_external_test_def_init
	@
	<<Prc external: external test def: TBP>>=
	procedure, nopass :: type_string => prc_external_test_def_type_string
	<<Prc external: sub interfaces>>=
	module function prc_external_test_def_type_string () result (string)
	type(string_t) :: string
	end function prc_external_test_def_type_string
	<<Prc external: procedures>>=
	module function prc_external_test_def_type_string () result (string)
	type(string_t) :: string
	string = "external test dummy"
	end function prc_external_test_def_type_string

	@ %def prc_external_def_type_string
	@
	<<Prc external: external test def: TBP>>=
	procedure :: write => prc_external_test_def_write
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_test_def_write (object, unit)
	class(prc_external_test_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine prc_external_test_def_write
	<<Prc external: procedures>>=
	module subroutine prc_external_test_def_write (object, unit)
	class(prc_external_test_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine prc_external_test_def_write

	@ %def prc_external_test_def_write
	@
	<<Prc external: external test def: TBP>>=
	procedure :: read => prc_external_test_def_read
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_test_def_read (object, unit)
	class(prc_external_test_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine prc_external_test_def_read
	<<Prc external: procedures>>=
	module subroutine prc_external_test_def_read (object, unit)
	class(prc_external_test_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine prc_external_test_def_read

	@ %def prc_external_test_def_read
	@ Gfortran 7/8/9 bug, has to remain in the main module.
	<<Prc external: external test def: TBP>>=
	procedure :: allocate_driver => prc_external_test_def_allocate_driver
	<<Prc external: main procedures>>=
	subroutine prc_external_test_def_allocate_driver (object, driver, basename)
	class(prc_external_test_def_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	if (.not. allocated (driver)) &
	allocate (prc_external_test_driver_t :: driver)
	end subroutine prc_external_test_def_allocate_driver

	@ %def prc_external_test_def_allocate_driver
	@
	\subsubsection{Core}
	This external test just returns $\|\mathcal{M}\|^2=1$ and thus the
	result of the integration is the n-particle-phase-space volume.
	<<Prc external: public>>=
	public :: prc_external_test_t
	<<Prc external: types>>=
	type, extends (prc_external_t) :: prc_external_test_t
	contains
	<<Prc external: prc test: TBP>>
	end type prc_external_test_t

	@ %def prc_external_test_t
	@
	<<Prc external: prc test: TBP>>=
	procedure :: write => prc_external_test_write
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_test_write (object, unit)
	class(prc_external_test_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_external_test_write
	<<Prc external: procedures>>=
	module subroutine prc_external_test_write (object, unit)
	class(prc_external_test_t), intent(in) :: object
	integer, intent(in), optional :: unit
	call msg_message ("Test external matrix elements")
	end subroutine prc_external_test_write

	@ %def prc_external_write
	@
	<<Prc external: prc test: TBP>>=
	procedure :: write_name => prc_external_test_write_name
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_test_write_name (object, unit)
	class(prc_external_test_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_external_test_write_name
	<<Prc external: procedures>>=
	module subroutine prc_external_test_write_name (object, unit)
	class(prc_external_test_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u,"(1x,A)") "Core: external test"
	end subroutine prc_external_test_write_name

	@ %def prc_external_test_write_name
	@
	<<Prc external: prc test: TBP>>=
	procedure :: compute_amplitude => prc_external_test_compute_amplitude
	<<Prc external: sub interfaces>>=
	module function prc_external_test_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(prc_external_test_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: &
	core_state
	complex(default) :: amp
	end function prc_external_test_compute_amplitude
	<<Prc external: procedures>>=
	module function prc_external_test_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(prc_external_test_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: core_state
	complex(default) :: amp
	select type (core_state)
	class is (prc_external_test_state_t)
	core_state%alpha_qcd = object%qcd%alpha%get (ren_scale)
	end select
	amp = 0.0
	end function prc_external_test_compute_amplitude

	@ %def prc_external_test_compute_amplitude
	@ Gfortran 7/8/9 bug, has to remain in the main module.
	<<Prc external: prc test: TBP>>=
	procedure :: allocate_workspace => prc_external_test_allocate_workspace
	<<Prc external: main procedures>>=
	subroutine prc_external_test_allocate_workspace (object, core_state)
	class(prc_external_test_t), intent(in) :: object
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	allocate (prc_external_test_state_t :: core_state)
	end subroutine prc_external_test_allocate_workspace

	@ %def prc_external_test_allocate_workspace
	@
	<<Prc external: prc test: TBP>>=
	procedure :: includes_polarization => &
	prc_external_test_includes_polarization
	<<Prc external: sub interfaces>>=
	module function prc_external_test_includes_polarization &
	(object) result (polarized)
	logical :: polarized
	class(prc_external_test_t), intent(in) :: object
	end function prc_external_test_includes_polarization
	<<Prc external: procedures>>=
	module function prc_external_test_includes_polarization &
	(object) result (polarized)
	logical :: polarized
	class(prc_external_test_t), intent(in) :: object
	polarized = .false.
	end function prc_external_test_includes_polarization

	@ %def prc_external_test_includes_polarization
	@
	<<Prc external: prc test: TBP>>=
	procedure :: prepare_external_code => &
	prc_external_test_prepare_external_code
	<<Prc external: sub interfaces>>=
	module subroutine prc_external_test_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_external_test_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	end subroutine prc_external_test_prepare_external_code
	<<Prc external: procedures>>=
	module subroutine prc_external_test_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_external_test_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	end subroutine prc_external_test_prepare_external_code

	@ %def prc_external_test_prepare_external_code
	@
	\subsection{Threshold}
	<<[[prc_threshold.f90]]>>=
	<<File header>>
	module prc_threshold

	use, intrinsic :: iso_c_binding !NODEP!

	use kinds
	<<Use strings>>
	<<Use debug>>
	use physics_defs
	use diagnostics
	use os_interface
	use lorentz
	use interactions
	use model_data
	use variables, only: var_list_t

	use prclib_interfaces
	use process_libraries
	use prc_core_def
	use prc_core
	use prc_external

	<<Standard module head>>

	<<Prc threshold: public>>

	<<Prc threshold: interfaces>>

	<<Prc threshold: types>>

	interface
	<<Prc threshold: sub interfaces>>
	end interface

	contains

	<<Prc threshold: main procedures>>

	end module prc_threshold
	@ %def prc_threshold
	@
	<<[[prc_threshold_sub.f90]]>>=
	<<File header>>

	submodule (prc_threshold) prc_threshold_s

	use constants
	use numeric_utils
	use string_utils, only: lower_case
	use io_units
	use system_defs, only: TAB
	use sm_qcd
	!!! Intel oneAPI 2022/23 regression workaround
	use variables, only: var_list_t

	implicit none

	contains

	<<Prc threshold: procedures>>

	end submodule prc_threshold_s

	@ %def prc_threshold_s
	@
	\subsubsection{Writer}
	<<Prc threshold: public>>=
	public :: threshold_writer_t
	<<Prc threshold: types>>=
	type, extends (prc_external_writer_t) :: threshold_writer_t
	integer :: nlo_type
	contains
	<<Prc threshold: threshold writer: TBP>>
	end type threshold_writer_t

	@ %def threshold_writer_t
	@
	<<Prc threshold: threshold writer: TBP>>=
	procedure :: init => threshold_writer_init
	<<Prc threshold: sub interfaces>>=
	pure module subroutine threshold_writer_init &
	- (writer, model_name, prt_in, prt_out, restrictions)
	+ (writer, model_name, prt_in, prt_out, ufo, ufo_path, restrictions)
	class(threshold_writer_t), intent(inout) :: writer
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in, prt_out
	+ logical, intent(in), optional :: ufo
	+ type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	end subroutine threshold_writer_init
	<<Prc threshold: procedures>>=
	pure module subroutine threshold_writer_init &
	- (writer, model_name, prt_in, prt_out, restrictions)
	+ (writer, model_name, prt_in, prt_out, ufo, ufo_path, restrictions)
	class(threshold_writer_t), intent(inout) :: writer
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in, prt_out
	+ logical, intent(in), optional :: ufo
	+ type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	- call writer%base_init (model_name, prt_in, prt_out, restrictions)
	+ call writer%base_init (model_name, prt_in, prt_out, ufo, ufo_path, restrictions)
	writer%amp_triv = .false.
	end subroutine threshold_writer_init

	@ %def threshold_writer_init
	@
	<<Prc threshold: threshold writer: TBP>>=
	procedure :: write_makefile_extra => threshold_writer_write_makefile_extra
	<<Prc threshold: sub interfaces>>=
	module subroutine threshold_writer_write_makefile_extra &
	(writer, unit, id, os_data, verbose, nlo_type)
	class(threshold_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	integer, intent(in) :: nlo_type
	end subroutine threshold_writer_write_makefile_extra
	<<Prc threshold: procedures>>=
	module subroutine threshold_writer_write_makefile_extra &
	(writer, unit, id, os_data, verbose, nlo_type)
	class(threshold_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	integer, intent(in) :: nlo_type
	type(string_t) :: f90in, f90, lo, extra
	if (debug_on) call msg_debug &
	(D_ME_METHODS, "threshold_writer_write_makefile_extra")
	if (nlo_type /= BORN) then
	extra = "_" // component_status (nlo_type)
	else
	extra = var_str ("")
	end if
	f90 = id // "_threshold" // extra //".f90"
	f90in = f90 // ".in"
	lo = id // "_threshold" // extra // ".lo"
	write (unit, "(A)") "OBJECTS += " // char (lo)
	write (unit, "(A)") char (f90in) // ":"
	write (unit, "(A)") char (TAB // "if ! test -f " // f90in // &
	"; then cp " // os_data%whizard_sharepath // &
	"/SM_tt_threshold_data/threshold" // extra // ".f90 " // &
	f90in // "; fi")
	write (unit, "(A)") char(f90) // ": " // char (f90in)
	write (unit, "(A)") TAB // "sed 's/@ID@/" // char (id) // "/' " // &
	char (f90in) // " > " // char (f90)
	write (unit, "(5A)") "CLEAN_SOURCES += ", char (f90)
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (f90in)
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), "_threshold.mod"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (lo)
	write (unit, "(A)") char(lo) // ": " // char (f90) // " " // &
	char(id) // ".f90"
	write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"
	if (.not. verbose) then
	write (unit, "(5A)") TAB // '@echo " FC " $@'
	end if
	end subroutine threshold_writer_write_makefile_extra

	@ %def threshold_writer_write_makefile_extra
	@
	<<Prc threshold: threshold writer: TBP>>=
	procedure :: write_makefile_code => threshold_writer_write_makefile_code
	<<Prc threshold: sub interfaces>>=
	module subroutine threshold_writer_write_makefile_code &
	(writer, unit, id, os_data, verbose, testflag)
	class(threshold_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	end subroutine threshold_writer_write_makefile_code
	<<Prc threshold: procedures>>=
	module subroutine threshold_writer_write_makefile_code &
	(writer, unit, id, os_data, verbose, testflag)
	class(threshold_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	if (debug_on) &
	call msg_debug (D_ME_METHODS, "threshold_writer_write_makefile_code")
	call writer%base_write_makefile_code &
	(unit, id, os_data, verbose, testflag = testflag)
	call writer%write_makefile_extra (unit, id, os_data, verbose, BORN)
	if (writer%nlo_type == NLO_VIRTUAL .and. writer%active) &
	call writer%write_makefile_extra (unit, id, os_data, verbose, writer%nlo_type)
	end subroutine threshold_writer_write_makefile_code

	@ %def threshold_writer_write_makefile_code
	@
	<<Prc threshold: threshold writer: TBP>>=
	procedure, nopass :: type_name => threshold_writer_type_name
	<<Prc threshold: sub interfaces>>=
	module function threshold_writer_type_name () result (string)
	type(string_t) :: string
	end function threshold_writer_type_name
	<<Prc threshold: procedures>>=
	module function threshold_writer_type_name () result (string)
	type(string_t) :: string
	string = "Threshold"
	end function threshold_writer_type_name

	@ %def threshold_writer_type_name
	@
	\subsubsection{Driver}
	<<Prc threshold: public>>=
	public :: threshold_set_process_mode
	<<Prc threshold: interfaces>>=
	interface
	subroutine threshold_set_process_mode (mode) bind(C)
	import
	integer(kind = c_int), intent(in) :: mode
	end subroutine threshold_set_process_mode
	end interface

	@ %def threshold_set_process_mode
	@
	<<Prc threshold: public>>=
	public :: threshold_get_amp_squared
	<<Prc threshold: interfaces>>=
	interface
	subroutine threshold_get_amp_squared (amp2, p_ofs, p_ons, leg, n_tot, sel_hel_beam) bind(C)
	import
	real(c_default_float), intent(out) :: amp2
	real(c_default_float), dimension(0:3,*), intent(in) :: p_ofs
	real(c_default_float), dimension(0:3,*), intent(in) :: p_ons
	integer(kind = c_int) :: n_tot, leg, sel_hel_beam
	end subroutine threshold_get_amp_squared
	end interface

	@ %def threshold_get_amp_squared
	@
	<<Prc threshold: public>>=
	public :: threshold_olp_eval2
	<<Prc threshold: interfaces>>=
	interface
	subroutine threshold_olp_eval2 (i_flv, alpha_s_c, parray, mu_c, &
	sel_hel_beam, sqme_c, acc_c) bind(C)
	import
	integer(c_int), intent(in) :: i_flv
	real(c_default_float), intent(in) :: alpha_s_c
	real(c_default_float), dimension(0:3,*), intent(in) :: parray
	real(c_default_float), intent(in) :: mu_c
	integer, intent(in) :: sel_hel_beam
	real(c_default_float), dimension(4), intent(out) :: sqme_c
	real(c_default_float), intent(out) :: acc_c
	end subroutine threshold_olp_eval2
	end interface

	@ %def threshold_olp_eval2
	@
	<<Prc threshold: public>>=
	public :: threshold_init
	<<Prc threshold: interfaces>>=
	interface
	subroutine threshold_init (par, scheme) bind(C)
	import
	real(c_default_float), dimension(*), intent(in) :: par
	integer(c_int), intent(in) :: scheme
	end subroutine threshold_init
	end interface

	@ %def threshold_init
	@
	<<Prc threshold: public>>=
	public :: threshold_start_openloops
	<<Prc threshold: interfaces>>=
	interface
	subroutine threshold_start_openloops () bind(C)
	import
	end subroutine threshold_start_openloops
	end interface

	@ %def threshold_start_openloops
	@
	<<Prc threshold: public>>=
	public :: threshold_driver_t
	<<Prc threshold: types>>=
	type, extends (prc_external_driver_t) :: threshold_driver_t
	procedure(threshold_olp_eval2), nopass, pointer :: &
	olp_eval2 => null ()
	procedure(threshold_set_process_mode), nopass, pointer :: &
	set_process_mode => null ()
	procedure(threshold_get_amp_squared), nopass, pointer :: &
	get_amp_squared => null ()
	procedure(threshold_start_openloops), nopass, pointer :: &
	start_openloops => null ()
	procedure(threshold_init), nopass, pointer :: &
	init => null ()
	type(string_t) :: id
	integer :: nlo_type = BORN
	contains
	<<Prc threshold: threshold driver: TBP>>
	end type threshold_driver_t

	@ %def threshold_driver_t
	@
	<<Prc threshold: threshold driver: TBP>>=
	procedure, nopass :: type_name => threshold_driver_type_name
	<<Prc threshold: sub interfaces>>=
	module function threshold_driver_type_name () result (type)
	type(string_t) :: type
	end function threshold_driver_type_name
	<<Prc threshold: procedures>>=
	module function threshold_driver_type_name () result (type)
	type(string_t) :: type
	type = "Threshold"
	end function threshold_driver_type_name

	@ %def threshold_driver_type_name
	@
	<<Prc threshold: threshold driver: TBP>>=
	procedure :: load => threshold_driver_load
	<<Prc threshold: sub interfaces>>=
	module subroutine threshold_driver_load (threshold_driver, dlaccess)
	class(threshold_driver_t), intent(inout) :: threshold_driver
	type(dlaccess_t), intent(inout) :: dlaccess
	end subroutine threshold_driver_load
	<<Prc threshold: procedures>>=
	module subroutine threshold_driver_load (threshold_driver, dlaccess)
	class(threshold_driver_t), intent(inout) :: threshold_driver
	type(dlaccess_t), intent(inout) :: dlaccess
	type(c_funptr) :: c_fptr
	type(string_t) :: lower_case_id
	if (debug_on) call msg_debug (D_ME_METHODS, "threshold_driver_load")
	lower_case_id = lower_case (threshold_driver%id)
	c_fptr = dlaccess_get_c_funptr (dlaccess, lower_case_id // "_set_process_mode")
	call c_f_procpointer (c_fptr, threshold_driver%set_process_mode)
	call check_for_error (lower_case_id // "_set_process_mode")
	c_fptr = dlaccess_get_c_funptr (dlaccess, lower_case_id // "_get_amp_squared")
	call c_f_procpointer (c_fptr, threshold_driver%get_amp_squared)
	call check_for_error (lower_case_id // "_get_amp_squared")
	c_fptr = dlaccess_get_c_funptr (dlaccess, lower_case_id // "_threshold_init")
	call c_f_procpointer (c_fptr, threshold_driver%init)
	call check_for_error (lower_case_id // "_threshold_init")
	select type (threshold_driver)
	type is (threshold_driver_t)
	if (threshold_driver%nlo_type == NLO_VIRTUAL) then
	c_fptr = dlaccess_get_c_funptr &
	(dlaccess, lower_case_id // "_start_openloops")
	call c_f_procpointer (c_fptr, threshold_driver%start_openloops)
	call check_for_error (lower_case_id // "_start_openloops")
	c_fptr = dlaccess_get_c_funptr (dlaccess, lower_case_id // "_olp_eval2")
	call c_f_procpointer (c_fptr, threshold_driver%olp_eval2)
	call check_for_error (lower_case_id // "_olp_eval2")
	end if
	end select
	call msg_message ("Loaded extra threshold functions")
	contains
	subroutine check_for_error (function_name)
	type(string_t), intent(in) :: function_name
	if (dlaccess_has_error (dlaccess)) call msg_fatal &
	(char ("Loading of " // function_name // " failed!"))
	end subroutine check_for_error
	end subroutine threshold_driver_load

	@ %def threshold_driver_load
	@
	\subsubsection{Configuration}
	<<Prc threshold: public>>=
	public :: threshold_def_t
	<<Prc threshold: types>>=
	type, extends (prc_external_def_t) :: threshold_def_t
	integer :: nlo_type
	contains
	<<Prc threshold: threshold def: TBP>>
	end type threshold_def_t

	@ %def threshold_def_t
	@ Gfortran 7/8/9 bug: has to remain in the main module.
	<<Prc threshold: threshold def: TBP>>=
	procedure :: init => threshold_def_init
	<<Prc threshold: main procedures>>=
	subroutine threshold_def_init (object, basename, model_name, &
	- prt_in, prt_out, nlo_type, restrictions)
	+ prt_in, prt_out, nlo_type, ufo, ufo_path, restrictions)
	class(threshold_def_t), intent(inout) :: object
	type(string_t), intent(in) :: basename, model_name
	type(string_t), dimension(:), intent(in) :: prt_in, prt_out
	integer, intent(in) :: nlo_type
	+ logical, intent(in), optional :: ufo
	+ type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	if (debug_on) call msg_debug (D_ME_METHODS, "threshold_def_init")
	object%basename = basename
	object%nlo_type = nlo_type
	allocate (threshold_writer_t :: object%writer)
	select type (writer => object%writer)
	type is (threshold_writer_t)
	- call writer%init (model_name, prt_in, prt_out, restrictions)
	+ call writer%init (model_name, prt_in, prt_out, ufo, ufo_path, restrictions)
	writer%nlo_type = nlo_type
	end select
	end subroutine threshold_def_init

	@ %def threshold_def_init
	@
	<<Prc threshold: threshold def: TBP>>=
	procedure, nopass :: type_string => threshold_def_type_string
	<<Prc threshold: sub interfaces>>=
	module function threshold_def_type_string () result (string)
	type(string_t) :: string
	end function threshold_def_type_string
	<<Prc threshold: procedures>>=
	module function threshold_def_type_string () result (string)
	type(string_t) :: string
	string = "threshold computation"
	end function threshold_def_type_string

	@ %def prc_external_def_type_string
	@ [[write]] and [[read]] could be put in the abstract version
	<<Prc threshold: threshold def: TBP>>=
	procedure :: write => threshold_def_write
	<<Prc threshold: sub interfaces>>=
	module subroutine threshold_def_write (object, unit)
	class(threshold_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine threshold_def_write
	<<Prc threshold: procedures>>=
	module subroutine threshold_def_write (object, unit)
	class(threshold_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine threshold_def_write

	@ %def threshold_def_write
	@
	<<Prc threshold: threshold def: TBP>>=
	procedure :: read => threshold_def_read
	<<Prc threshold: sub interfaces>>=
	module subroutine threshold_def_read (object, unit)
	class(threshold_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine threshold_def_read
	<<Prc threshold: procedures>>=
	module subroutine threshold_def_read (object, unit)
	class(threshold_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine threshold_def_read

	@ %def threshold_def_read
	@ Gfortran 7/8/9 bug: has to remain in the main module.
	<<Prc threshold: threshold def: TBP>>=
	procedure :: allocate_driver => threshold_def_allocate_driver
	<<Prc threshold: main procedures>>=
	subroutine threshold_def_allocate_driver (object, driver, basename)
	class(threshold_def_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	if (debug_on) call msg_debug (D_ME_METHODS, "threshold_def_allocate_driver")
	if (.not. allocated (driver)) allocate (threshold_driver_t :: driver)
	select type (driver)
	type is (threshold_driver_t)
	driver%id = basename
	driver%nlo_type = object%nlo_type
	end select
	end subroutine threshold_def_allocate_driver

	@ %def threshold_def_allocate_driver
	@
	<<Prc threshold: threshold def: TBP>>=
	procedure :: connect => threshold_def_connect
	<<Prc threshold: sub interfaces>>=
	module subroutine threshold_def_connect (def, lib_driver, i, proc_driver)
	class(threshold_def_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	end subroutine threshold_def_connect
	<<Prc threshold: procedures>>=
	module subroutine threshold_def_connect (def, lib_driver, i, proc_driver)
	class(threshold_def_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	type(dlaccess_t) :: dlaccess
	logical :: skip
	if (debug_on) call msg_debug (D_ME_METHODS, "threshold_def_connect")
	call def%omega_connect (lib_driver, i, proc_driver)
	select type (lib_driver)
	class is (prclib_driver_dynamic_t)
	dlaccess = lib_driver%dlaccess
	end select
	select type (proc_driver)
	class is (threshold_driver_t)
	select type (writer => def%writer)
	type is (threshold_writer_t)
	skip = writer%nlo_type == NLO_VIRTUAL .and. .not. writer%active
	if (.not. skip) call proc_driver%load (dlaccess)
	end select
	end select
	end subroutine threshold_def_connect

	@ %def threshold_def_connect
	@
	\subsubsection{Core state}
	<<Prc threshold: public>>=
	public :: threshold_state_t
	<<Prc threshold: types>>=
	type, extends (prc_external_state_t) :: threshold_state_t
	contains
	<<Prc threshold: threshold state: TBP>>
	end type threshold_state_t

	@ %def threshold_state_t
	@
	<<Prc threshold: threshold state: TBP>>=
	procedure :: write => threshold_state_write
	<<Prc threshold: sub interfaces>>=
	module subroutine threshold_state_write (object, unit)
	class(threshold_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine threshold_state_write
	<<Prc threshold: procedures>>=
	module subroutine threshold_state_write (object, unit)
	class(threshold_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine threshold_state_write

	@ %def threshold_state_write
	@
	\subsubsection{Core}
	<<Prc threshold: public>>=
	public :: prc_threshold_t
	<<Prc threshold: types>>=
	type, extends (prc_external_t) :: prc_threshold_t
	real(default), dimension(:,:), allocatable :: parray_ofs
	real(default), dimension(:,:), allocatable :: parray_ons
	integer :: leg
	logical :: has_beam_pol = .false.
	contains
	<<Prc threshold: prc threshold: TBP>>
	end type prc_threshold_t

	@ %def prc_threshold_t
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: write => prc_threshold_write
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_write (object, unit)
	class(prc_threshold_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_threshold_write
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_write (object, unit)
	class(prc_threshold_t), intent(in) :: object
	integer, intent(in), optional :: unit
	call msg_message ("Supply amplitudes squared for threshold computation")
	end subroutine prc_threshold_write

	@ %def prc_external_write
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: write_name => prc_threshold_write_name
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_write_name (object, unit)
	class(prc_threshold_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_threshold_write_name
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_write_name (object, unit)
	class(prc_threshold_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u,"(1x,A)") "Core: Threshold"
	end subroutine prc_threshold_write_name

	@ %def prc_threshold_write_name
	@
	This core type has the beam polarization as an extra parameter.
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: set_beam_pol => prc_threshold_set_beam_pol
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_set_beam_pol (object, has_beam_pol)
	class(prc_threshold_t), intent(inout) :: object
	logical, intent(in), optional :: has_beam_pol
	end subroutine prc_threshold_set_beam_pol
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_set_beam_pol (object, has_beam_pol)
	class(prc_threshold_t), intent(inout) :: object
	logical, intent(in), optional :: has_beam_pol
	if (present (has_beam_pol)) then
	object%has_beam_pol = has_beam_pol
	end if
	end subroutine prc_threshold_set_beam_pol

	@ %def prc_threshold_set_beam_pol
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: compute_amplitude => prc_threshold_compute_amplitude
	<<Prc threshold: sub interfaces>>=
	module function prc_threshold_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(prc_threshold_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: &
	core_state
	complex(default) :: amp
	end function prc_threshold_compute_amplitude
	<<Prc threshold: procedures>>=
	module function prc_threshold_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(prc_threshold_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: core_state
	complex(default) :: amp
	select type (core_state)
	class is (prc_external_test_state_t)
	core_state%alpha_qcd = object%qcd%alpha%get (ren_scale)
	end select
	amp = 0
	end function prc_threshold_compute_amplitude

	@ %def prc_threshold_compute_amplitude
	@ Gfortran 7/8/9 bug: has to remain in the main module.
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: allocate_workspace => prc_threshold_allocate_workspace
	<<Prc threshold: main procedures>>=
	subroutine prc_threshold_allocate_workspace (object, core_state)
	class(prc_threshold_t), intent(in) :: object
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	allocate (threshold_state_t :: core_state)
	end subroutine prc_threshold_allocate_workspace

	@ %def prc_threshold_allocate_workspace
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: set_offshell_momenta => prc_threshold_set_offshell_momenta
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_set_offshell_momenta (object, p)
	class(prc_threshold_t), intent(inout) :: object
	type(vector4_t), intent(in), dimension(:) :: p
	end subroutine prc_threshold_set_offshell_momenta
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_set_offshell_momenta (object, p)
	class(prc_threshold_t), intent(inout) :: object
	type(vector4_t), intent(in), dimension(:) :: p
	integer :: i
	do i = 1, size(p)
	object%parray_ofs(:,i) = p(i)%p
	end do
	end subroutine prc_threshold_set_offshell_momenta

	@ %def prc_threshold_set_offshell_momenta
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: set_onshell_momenta => prc_threshold_set_onshell_momenta
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_set_onshell_momenta (object, p)
	class(prc_threshold_t), intent(inout) :: object
	type(vector4_t), intent(in), dimension(:) :: p
	end subroutine prc_threshold_set_onshell_momenta
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_set_onshell_momenta (object, p)
	class(prc_threshold_t), intent(inout) :: object
	type(vector4_t), intent(in), dimension(:) :: p
	integer :: i
	do i = 1, size(p)
	object%parray_ons(:,i) = p(i)%p
	end do
	end subroutine prc_threshold_set_onshell_momenta

	@ %def prc_threshold_set_onshell_momenta
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: set_leg => prc_threshold_set_leg
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_set_leg (object, leg)
	class(prc_threshold_t), intent(inout) :: object
	integer, intent(in) :: leg
	end subroutine prc_threshold_set_leg
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_set_leg (object, leg)
	class(prc_threshold_t), intent(inout) :: object
	integer, intent(in) :: leg
	object%leg = leg
	end subroutine prc_threshold_set_leg

	@ %def prc_threshold_set_leg
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: set_process_mode => prc_threshold_set_process_mode
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_set_process_mode (object, mode)
	class(prc_threshold_t), intent(in) :: object
	integer(kind = c_int), intent(in) :: mode
	end subroutine prc_threshold_set_process_mode
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_set_process_mode (object, mode)
	class(prc_threshold_t), intent(in) :: object
	integer(kind = c_int), intent(in) :: mode
	select type (driver => object%driver)
	class is (threshold_driver_t)
	if (associated (driver%set_process_mode)) &
	call driver%set_process_mode (mode)
	end select
	end subroutine prc_threshold_set_process_mode

	@ %def prc_threshold_set_process_mode
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: compute_sqme => prc_threshold_compute_sqme
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_compute_sqme (object, i_flv, i_hel, p, &
	ren_scale, sqme, bad_point)
	class(prc_threshold_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out) :: sqme
	logical, intent(out) :: bad_point
	end subroutine prc_threshold_compute_sqme
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_compute_sqme (object, i_flv, i_hel, p, &
	ren_scale, sqme, bad_point)
	class(prc_threshold_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out) :: sqme
	logical, intent(out) :: bad_point
	integer :: n_tot
	if (debug_on) call msg_debug2 (D_ME_METHODS, "prc_threshold_compute_sqme")
	n_tot = size (p)
	select type (driver => object%driver)
	class is (threshold_driver_t)
	if (object%has_beam_pol) then
	call driver%get_amp_squared (sqme, object%parray_ofs, &
	object%parray_ons, object%leg, n_tot, i_flv - 1)
	else
	call driver%get_amp_squared (sqme, object%parray_ofs, &
	object%parray_ons, object%leg, n_tot, -1)
	end if
	end select
	bad_point = .false.
	end subroutine prc_threshold_compute_sqme

	@ %def prc_threshold_compute_sqme
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: compute_sqme_virt => prc_threshold_compute_sqme_virt
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_compute_sqme_virt (object, i_flv, i_hel, &
	p, ren_scale, es_scale, loop_method, sqme, bad_point)
	class(prc_threshold_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale, es_scale
	integer, intent(in) :: loop_method
	real(default), dimension(4), intent(out) :: sqme
	real(c_default_float), dimension(:,:), allocatable, save :: parray
	logical, intent(out) :: bad_point
	end subroutine prc_threshold_compute_sqme_virt
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_compute_sqme_virt (object, i_flv, i_hel, &
	p, ren_scale, es_scale, loop_method, sqme, bad_point)
	class(prc_threshold_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale, es_scale
	integer, intent(in) :: loop_method
	real(default), dimension(4), intent(out) :: sqme
	real(c_default_float), dimension(:,:), allocatable, save :: parray
	logical, intent(out) :: bad_point
	integer :: n_tot, i
	real(default) :: mu
	real(c_default_float), dimension(4) :: sqme_c
	real(c_default_float) :: mu_c, acc_c, alpha_s_c
	integer(c_int) :: i_flv_c
	if (debug_on) call msg_debug2 (D_ME_METHODS, "prc_threshold_compute_sqme_virt")
	n_tot = size (p)
	if (allocated (parray)) then
	if (size(parray) /= n_tot) deallocate (parray)
	end if
	if (.not. allocated (parray)) allocate (parray (0:3, n_tot))
	forall (i = 1:n_tot) parray(:,i) = p(i)%p

	if (vanishes (ren_scale)) then
	mu = sqrt (2* (p(1)*p(2)))
	else
	mu = ren_scale
	end if
	mu_c = mu
	alpha_s_c = object%qcd%alpha%get (mu)
	i_flv_c = i_flv
	select type (driver => object%driver)
	class is (threshold_driver_t)
	if (associated (driver%olp_eval2)) then
	if (object%has_beam_pol) then
	call driver%olp_eval2 (1, alpha_s_c, &
	parray, mu_c, i_flv_c - 1, sqme_c, acc_c)
	else
	call driver%olp_eval2 (i_flv_c, alpha_s_c, &
	parray, mu_c, -1, sqme_c, acc_c)
	end if
	bad_point = real(acc_c, kind=default) > object%maximum_accuracy
	sqme = sqme_c
	else
	sqme = 0._default
	bad_point = .true.
	end if
	end select
	end subroutine prc_threshold_compute_sqme_virt

	@ %def prc_threshold_compute_sqme_virt
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: init => prc_threshold_init
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_init (object, def, lib, id, i_component)
	class(prc_threshold_t), intent(inout) :: object
	class(prc_core_def_t), intent(in), target :: def
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	end subroutine prc_threshold_init
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_init (object, def, lib, id, i_component)
	class(prc_threshold_t), intent(inout) :: object
	class(prc_core_def_t), intent(in), target :: def
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	integer :: n_tot
	call object%base_init (def, lib, id, i_component)
	n_tot = object%data%n_in + object%data%n_out
	allocate (object%parray_ofs (0:3,n_tot), object%parray_ons (0:3,n_tot))
	if (n_tot == 4) then
	call object%set_process_mode (PROC_MODE_TT)
	else
	call object%set_process_mode (PROC_MODE_WBWB)
	end if
	call object%activate_parameters ()
	end subroutine prc_threshold_init

	@ %def prc_threshold_init
	@ Activate the stored parameters by transferring them to the external
	matrix element.
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: activate_parameters => prc_threshold_activate_parameters
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_activate_parameters (object)
	class (prc_threshold_t), intent(inout) :: object
	end subroutine prc_threshold_activate_parameters
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_activate_parameters (object)
	class (prc_threshold_t), intent(inout) :: object
	if (debug_on) &
	call msg_debug (D_ME_METHODS, "prc_threshold_activate_parameters")
	if (allocated (object%driver)) then
	if (allocated (object%par)) then
	select type (driver => object%driver)
	type is (threshold_driver_t)
	if (associated (driver%init)) then
	call driver%init (object%par, object%scheme)
	end if
	end select
	else
	call msg_bug &
	("prc_threshold_activate: parameter set is not allocated")
	end if
	else
	call msg_bug ("prc_threshold_activate: driver is not allocated")
	end if
	end subroutine prc_threshold_activate_parameters

	@ %def prc_threshold_activate_parameters
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: prepare_external_code => &
	prc_threshold_prepare_external_code
	<<Prc threshold: sub interfaces>>=
	module subroutine prc_threshold_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_threshold_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	end subroutine prc_threshold_prepare_external_code
	<<Prc threshold: procedures>>=
	module subroutine prc_threshold_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_threshold_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	if (debug_on) call msg_debug (D_ME_METHODS, &
	"prc_threshold_prepare_external_code")
	if (allocated (core%driver)) then
	select type (driver => core%driver)
	type is (threshold_driver_t)
	if (driver%nlo_type == NLO_VIRTUAL) call driver%start_openloops ()
	end select
	else
	call msg_bug ("prc_threshold_prepare_external_code: " &
	// "driver is not allocated")
	end if
	end subroutine prc_threshold_prepare_external_code

	@ %def prc_threshold_prepare_external_code
	@
	<<Prc threshold: prc threshold: TBP>>=
	procedure :: includes_polarization => prc_threshold_includes_polarization
	<<Prc threshold: sub interfaces>>=
	module function prc_threshold_includes_polarization &
	(object) result (polarized)
	logical :: polarized
	class(prc_threshold_t), intent(in) :: object
	end function prc_threshold_includes_polarization
	<<Prc threshold: procedures>>=
	module function prc_threshold_includes_polarization &
	(object) result (polarized)
	logical :: polarized
	class(prc_threshold_t), intent(in) :: object
	polarized = object%has_beam_pol
	end function prc_threshold_includes_polarization

	@ %def prc_threshold_includes_polarization
	@
	Index: trunk/src/model_features/model_features.nw
	===================================================================
	--- trunk/src/model_features/model_features.nw (revision 8903)
	+++ trunk/src/model_features/model_features.nw (revision 8904)
	@@ -1,18873 +1,18883 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: model features
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Model Handling and Features}
	\includemodulegraph{model_features}

	These modules deal with process definitions and physics models.

	These modules use the [[model_data]] methods to automatically generate
	process definitions.
	\begin{description}
	\item[auto\_components]
	Generic process-definition generator. We can specify a basic
	process or initial particle(s) and some rules to extend this
	process, given a model definition with particle names and vertex
	structures.
	\item[radiation\_generator]
	Applies the generic generator to the specific problem of generating
	NLO corrections in a restricted setup.
	\end{description}

	Model construction:
	\begin{description}
	\item[eval\_trees]
	Implementation of the generic [[expr_t]] type for the concrete
	evaluation of expressions that access user variables.

	This module is actually part of the Sindarin language implementation, and
	should be moved elsewhere. Currently, the [[models]] module relies
	on it.
	\item[models]
	Extends the [[model_data_t]] structure by user-variable objects for
	easy access, and provides the means to read a model definition from file.
	\item[slha\_interface]
	Read/write a SUSY model in the standardized SLHA format. The format
	defines fields and parameters, but no vertices.
	\end{description}

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Automatic generation of process components}

	This module provides the functionality for automatically generating radiation
	corrections or decays, provided as lists of PDG codes.
	<<[[auto_components.f90]]>>=
	<<File header>>

	module auto_components

	<<Use kinds>>
	<<Use strings>>
	use model_data
	use pdg_arrays

	<<Standard module head>>

	<<Auto components: public>>

	<<Auto components: types>>

	<<Auto components: interfaces>>

	interface
	<<Auto components: sub interfaces>>
	end interface

	contains

	<<Auto components: main procedures>>

	end module auto_components
	@ %def auto_components
	@
	<<[[auto_components_sub.f90]]>>=
	<<File header>>

	submodule (auto_components) auto_components_s

	use io_units
	use diagnostics
	use physics_defs, only: PHOTON, GLUON, Z_BOSON, W_BOSON
	use numeric_utils, only: extend_integer_array

	implicit none

	<<Auto components: parameters>>

	contains

	<<Auto components: procedures>>

	end submodule auto_components_s

	@ %def auto_components_s
	@
	\subsection{Constraints: Abstract types}
	An abstract type that denotes a constraint on the automatically generated
	states. The concrete objects are applied as visitor objects at certain hooks
	during the splitting algorithm.
	<<Auto components: types>>=
	type, abstract :: split_constraint_t
	contains
	<<Auto components: split constraint: TBP>>
	end type split_constraint_t

	@ %def split_constraint_t
	@ By default, all checks return true.
	<<Auto components: split constraint: TBP>>=
	procedure :: check_before_split => split_constraint_check_before_split
	procedure :: check_before_insert => split_constraint_check_before_insert
	procedure :: check_before_record => split_constraint_check_before_record
	<<Auto components: sub interfaces>>=
	module subroutine split_constraint_check_before_split (c, table, pl, k, passed)
	class(split_constraint_t), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: k
	logical, intent(out) :: passed
	end subroutine split_constraint_check_before_split
	module subroutine split_constraint_check_before_insert (c, table, pa, pl, passed)
	class(split_constraint_t), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	end subroutine split_constraint_check_before_insert
	module subroutine split_constraint_check_before_record (c, table, pl, n_loop, passed)
	class(split_constraint_t), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	end subroutine split_constraint_check_before_record
	<<Auto components: procedures>>=
	module subroutine split_constraint_check_before_split (c, table, pl, k, passed)
	class(split_constraint_t), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: k
	logical, intent(out) :: passed
	passed = .true.
	end subroutine split_constraint_check_before_split

	module subroutine split_constraint_check_before_insert (c, table, pa, pl, passed)
	class(split_constraint_t), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	passed = .true.
	end subroutine split_constraint_check_before_insert

	module subroutine split_constraint_check_before_record (c, table, pl, n_loop, passed)
	class(split_constraint_t), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	passed = .true.
	end subroutine split_constraint_check_before_record

	@ %def check_before_split
	@ %def check_before_insert
	@ %def check_before_record
	@ A transparent wrapper, so we can collect constraints of different type.
	<<Auto components: types>>=
	type :: split_constraint_wrap_t
	class(split_constraint_t), allocatable :: c
	end type split_constraint_wrap_t

	@ %def split_constraint_wrap_t
	@ A collection of constraints.
	<<Auto components: public>>=
	public :: split_constraints_t
	<<Auto components: types>>=
	type :: split_constraints_t
	class(split_constraint_wrap_t), dimension(:), allocatable :: cc
	contains
	<<Auto components: split constraints: TBP>>
	end type split_constraints_t

	@ %def split_constraints_t
	@ Gfortran 7/8/9 bug: has to remain in the main module.
	Initialize the constraints set with a specific number of elements.
	<<Auto components: split constraints: TBP>>=
	procedure :: init => split_constraints_init
	<<Auto components: main procedures>>=
	subroutine split_constraints_init (constraints, n)
	class(split_constraints_t), intent(out) :: constraints
	integer, intent(in) :: n
	allocate (constraints%cc (n))
	end subroutine split_constraints_init

	@ %def split_constraints_init
	@ Set a constraint.
	<<Auto components: split constraints: TBP>>=
	procedure :: set => split_constraints_set
	<<Auto components: sub interfaces>>=
	module subroutine split_constraints_set (constraints, i, c)
	class(split_constraints_t), intent(inout) :: constraints
	integer, intent(in) :: i
	class(split_constraint_t), intent(in) :: c
	end subroutine split_constraints_set
	<<Auto components: procedures>>=
	module subroutine split_constraints_set (constraints, i, c)
	class(split_constraints_t), intent(inout) :: constraints
	integer, intent(in) :: i
	class(split_constraint_t), intent(in) :: c
	allocate (constraints%cc(i)%c, source = c)
	end subroutine split_constraints_set

	@ %def split_constraints_set
	@ Apply checks.

	[[check_before_split]] is applied to the particle list that we want
	to split.

	[[check_before_insert]] is applied to the particle list [[pl]] that is to
	replace the particle [[pa]] that is split. This check may transform the
	particle list.

	[[check_before_record]] is applied to the complete new particle list that
	results from splitting before it is recorded.
	<<Auto components: split constraints: TBP>>=
	procedure :: check_before_split => split_constraints_check_before_split
	procedure :: check_before_insert => split_constraints_check_before_insert
	procedure :: check_before_record => split_constraints_check_before_record
	<<Auto components: sub interfaces>>=
	module subroutine split_constraints_check_before_split &
	(constraints, table, pl, k, passed)
	class(split_constraints_t), intent(in) :: constraints
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: k
	logical, intent(out) :: passed
	end subroutine split_constraints_check_before_split
	module subroutine split_constraints_check_before_insert &
	(constraints, table, pa, pl, passed)
	class(split_constraints_t), intent(in) :: constraints
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	end subroutine split_constraints_check_before_insert
	module subroutine split_constraints_check_before_record &
	(constraints, table, pl, n_loop, passed)
	class(split_constraints_t), intent(in) :: constraints
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	end subroutine split_constraints_check_before_record
	<<Auto components: procedures>>=
	module subroutine split_constraints_check_before_split &
	(constraints, table, pl, k, passed)
	class(split_constraints_t), intent(in) :: constraints
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: k
	logical, intent(out) :: passed
	integer :: i
	passed = .true.
	do i = 1, size (constraints%cc)
	call constraints%cc(i)%c%check_before_split (table, pl, k, passed)
	if (.not. passed) return
	end do
	end subroutine split_constraints_check_before_split

	module subroutine split_constraints_check_before_insert &
	(constraints, table, pa, pl, passed)
	class(split_constraints_t), intent(in) :: constraints
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	integer :: i
	passed = .true.
	do i = 1, size (constraints%cc)
	call constraints%cc(i)%c%check_before_insert (table, pa, pl, passed)
	if (.not. passed) return
	end do
	end subroutine split_constraints_check_before_insert

	module subroutine split_constraints_check_before_record &
	(constraints, table, pl, n_loop, passed)
	class(split_constraints_t), intent(in) :: constraints
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	integer :: i
	passed = .true.
	do i = 1, size (constraints%cc)
	call constraints%cc(i)%c%check_before_record (table, pl, n_loop, passed)
	if (.not. passed) return
	end do
	end subroutine split_constraints_check_before_record

	@ %def split_constraints_check_before_split
	@ %def split_constraints_check_before_insert
	@ %def split_constraints_check_before_record
	@
	\subsection{Specific constraints}
	\subsubsection{Number of particles}
	Specific constraint: The number of particles plus the number of loops, if
	any, must remain less than the given limit. Note that the number of loops is
	defined only when we are recording the entry.
	<<Auto components: types>>=
	type, extends (split_constraint_t) :: constraint_n_tot
	private
	integer :: n_max = 0
	contains
	procedure :: check_before_split => constraint_n_tot_check_before_split
	procedure :: check_before_record => constraint_n_tot_check_before_record
	end type constraint_n_tot

	@ %def constraint_n_tot
	<<Auto components: public>>=
	public :: constrain_n_tot
	<<Auto components: sub interfaces>>=
	module function constrain_n_tot (n_max) result (c)
	integer, intent(in) :: n_max
	type(constraint_n_tot) :: c
	end function constrain_n_tot
	module subroutine constraint_n_tot_check_before_split (c, table, pl, k, passed)
	class(constraint_n_tot), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: k
	logical, intent(out) :: passed
	end subroutine constraint_n_tot_check_before_split
	module subroutine constraint_n_tot_check_before_record (c, table, pl, n_loop, passed)
	class(constraint_n_tot), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	end subroutine constraint_n_tot_check_before_record
	<<Auto components: procedures>>=
	module function constrain_n_tot (n_max) result (c)
	integer, intent(in) :: n_max
	type(constraint_n_tot) :: c
	c%n_max = n_max
	end function constrain_n_tot

	module subroutine constraint_n_tot_check_before_split (c, table, pl, k, passed)
	class(constraint_n_tot), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: k
	logical, intent(out) :: passed
	passed = pl%get_size () < c%n_max
	end subroutine constraint_n_tot_check_before_split

	module subroutine constraint_n_tot_check_before_record (c, table, pl, n_loop, passed)
	class(constraint_n_tot), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	passed = pl%get_size () + n_loop <= c%n_max
	end subroutine constraint_n_tot_check_before_record

	@ %def constrain_n_tot
	@ %def constraint_n_tot_check_before_insert
	@
	\subsubsection{Number of loops}
	Specific constraint: The number of loops is limited, independent of the
	total number of particles.
	<<Auto components: types>>=
	type, extends (split_constraint_t) :: constraint_n_loop
	private
	integer :: n_loop_max = 0
	contains
	procedure :: check_before_record => constraint_n_loop_check_before_record
	end type constraint_n_loop

	@ %def constraint_n_loop
	<<Auto components: public>>=
	public :: constrain_n_loop
	<<Auto components: sub interfaces>>=
	module function constrain_n_loop (n_loop_max) result (c)
	integer, intent(in) :: n_loop_max
	type(constraint_n_loop) :: c
	end function constrain_n_loop
	module subroutine constraint_n_loop_check_before_record &
	(c, table, pl, n_loop, passed)
	class(constraint_n_loop), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	end subroutine constraint_n_loop_check_before_record
	<<Auto components: procedures>>=
	module function constrain_n_loop (n_loop_max) result (c)
	integer, intent(in) :: n_loop_max
	type(constraint_n_loop) :: c
	c%n_loop_max = n_loop_max
	end function constrain_n_loop

	module subroutine constraint_n_loop_check_before_record &
	(c, table, pl, n_loop, passed)
	class(constraint_n_loop), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	passed = n_loop <= c%n_loop_max
	end subroutine constraint_n_loop_check_before_record

	@ %def constrain_n_loop
	@ %def constraint_n_loop_check_before_insert
	@
	\subsubsection{Particles allowed in splitting}
	Specific constraint: The entries in the particle list ready for insertion
	are matched to a given list of particle patterns. If a match occurs, the
	entry is replaced by the corresponding pattern. If there is no match, the
	check fails. If a massless gauge boson splitting is detected, the splitting
	partners are checked against a list of excluded particles. If a match
	occurs, the check fails.
	<<Auto components: types>>=
	type, extends (split_constraint_t) :: constraint_splittings
	private
	type(pdg_list_t) :: pl_match, pl_excluded_gauge_splittings
	contains
	procedure :: check_before_insert => constraint_splittings_check_before_insert
	end type constraint_splittings

	@ %def constraint_splittings
	<<Auto components: public>>=
	public :: constrain_splittings
	<<Auto components: sub interfaces>>=
	module function constrain_splittings &
	(pl_match, pl_excluded_gauge_splittings) result (c)
	type(pdg_list_t), intent(in) :: pl_match
	type(pdg_list_t), intent(in) :: pl_excluded_gauge_splittings
	type(constraint_splittings) :: c
	end function constrain_splittings
	module subroutine constraint_splittings_check_before_insert &
	(c, table, pa, pl, passed)
	class(constraint_splittings), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	end subroutine constraint_splittings_check_before_insert
	<<Auto components: procedures>>=
	module function constrain_splittings &
	(pl_match, pl_excluded_gauge_splittings) result (c)
	type(pdg_list_t), intent(in) :: pl_match
	type(pdg_list_t), intent(in) :: pl_excluded_gauge_splittings
	type(constraint_splittings) :: c
	c%pl_match = pl_match
	c%pl_excluded_gauge_splittings = pl_excluded_gauge_splittings
	end function constrain_splittings

	module subroutine constraint_splittings_check_before_insert &
	(c, table, pa, pl, passed)
	class(constraint_splittings), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	logical :: has_massless_vector
	integer :: i
	has_massless_vector = .false.
	do i = 1, pa%get_length ()
	if (is_massless_vector(pa%get(i))) then
	has_massless_vector = .true.
	exit
	end if
	end do
	passed = .false.
	if (has_massless_vector .and. count (is_fermion(pl%a%get ())) == 2) then
	do i = 1, c%pl_excluded_gauge_splittings%get_size ()
	if (pl .match. c%pl_excluded_gauge_splittings%a(i)) return
	end do
	call pl%match_replace (c%pl_match, passed)
	passed = .true.
	else
	call pl%match_replace (c%pl_match, passed)
	end if
	end subroutine constraint_splittings_check_before_insert

	@ %def constrain_splittings
	@ %def constraint_splittings_check_before_insert
	@
	Specific constraint: The entries in the particle list ready for insertion
	are matched to a given list of particle patterns. If a match occurs, the
	entry is replaced by the corresponding pattern. If there is no match, the
	check fails.
	<<Auto components: types>>=
	type, extends (split_constraint_t) :: constraint_insert
	private
	type(pdg_list_t) :: pl_match
	contains
	procedure :: check_before_insert => constraint_insert_check_before_insert
	end type constraint_insert

	@ %def constraint_insert
	<<Auto components: public>>=
	public :: constrain_insert
	<<Auto components: sub interfaces>>=
	module function constrain_insert (pl_match) result (c)
	type(pdg_list_t), intent(in) :: pl_match
	type(constraint_insert) :: c
	end function constrain_insert
	module subroutine constraint_insert_check_before_insert (c, table, pa, pl, passed)
	class(constraint_insert), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	end subroutine constraint_insert_check_before_insert
	<<Auto components: procedures>>=
	module function constrain_insert (pl_match) result (c)
	type(pdg_list_t), intent(in) :: pl_match
	type(constraint_insert) :: c
	c%pl_match = pl_match
	end function constrain_insert

	module subroutine constraint_insert_check_before_insert (c, table, pa, pl, passed)
	class(constraint_insert), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	call pl%match_replace (c%pl_match, passed)
	end subroutine constraint_insert_check_before_insert

	@ %def constrain_insert
	@ %def constraint_insert_check_before_insert
	@
	\subsubsection{Particles required in final state}
	Specific constraint: The entries in the recorded state must be a superset of
	the entries in the given list (for instance, the lowest-order
	state).
	<<Auto components: types>>=
	type, extends (split_constraint_t) :: constraint_require
	private
	type(pdg_list_t) :: pl
	contains
	procedure :: check_before_record => constraint_require_check_before_record
	end type constraint_require

	@ %def constraint_require
	@ We check the current state by matching all particle entries against the
	stored particle list, and crossing out the particles in the latter list when a
	match is found. The constraint passed if all entries have been crossed out.

	For an [[if_table]] in particular, we check the final state only.
	<<Auto components: public>>=
	public :: constrain_require
	<<Auto components: sub interfaces>>=
	module function constrain_require (pl) result (c)
	type(pdg_list_t), intent(in) :: pl
	type(constraint_require) :: c
	end function constrain_require
	module subroutine constraint_require_check_before_record &
	(c, table, pl, n_loop, passed)
	class(constraint_require), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	end subroutine constraint_require_check_before_record
	<<Auto components: procedures>>=
	module function constrain_require (pl) result (c)
	type(pdg_list_t), intent(in) :: pl
	type(constraint_require) :: c
	c%pl = pl
	end function constrain_require

	module subroutine constraint_require_check_before_record &
	(c, table, pl, n_loop, passed)
	class(constraint_require), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	logical, dimension(:), allocatable :: mask
	integer :: i, k, n_in
	select type (table)
	type is (if_table_t)
	if (table%proc_type > 0) then
	select case (table%proc_type)
	case (PROC_DECAY)
	n_in = 1
	case (PROC_SCATTER)
	n_in = 2
	end select
	else
	call msg_fatal ("Neither a decay nor a scattering process")
	end if
	class default
	n_in = 0
	end select
	allocate (mask (c%pl%get_size ()), source = .true.)
	do i = n_in + 1, pl%get_size ()
	k = c%pl%find_match (pl%get (i), mask)
	if (k /= 0) mask(k) = .false.
	end do
	passed = .not. any (mask)
	end subroutine constraint_require_check_before_record

	@ %def constrain_require
	@ %def constraint_require_check_before_record
	@
	\subsubsection{Radiation}
	Specific constraint: We have radiation pattern if the original particle
	matches an entry in the list of particles that should replace it. The
	constraint prohibits this situation.
	<<Auto components: public>>=
	public :: constrain_radiation
	<<Auto components: types>>=
	type, extends (split_constraint_t) :: constraint_radiation
	private
	contains
	procedure :: check_before_insert => &
	constraint_radiation_check_before_insert
	end type constraint_radiation

	@ %def constraint_radiation
	<<Auto components: sub interfaces>>=
	module function constrain_radiation () result (c)
	type(constraint_radiation) :: c
	end function constrain_radiation
	module subroutine constraint_radiation_check_before_insert &
	(c, table, pa, pl, passed)
	class(constraint_radiation), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	end subroutine constraint_radiation_check_before_insert
	<<Auto components: procedures>>=
	module function constrain_radiation () result (c)
	type(constraint_radiation) :: c
	end function constrain_radiation

	module subroutine constraint_radiation_check_before_insert &
	(c, table, pa, pl, passed)
	class(constraint_radiation), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	passed = .not. (pl .match. pa)
	end subroutine constraint_radiation_check_before_insert

	@ %def constrain_radiation
	@ %def constraint_radiation_check_before_insert
	@
	\subsubsection{Mass sum}
	Specific constraint: The sum of masses within the particle list must
	be smaller than a given limit. For in/out state combinations, we
	check initial and final state separately.

	If we specify [[margin]] in the initialization, the sum must be
	strictly less than the limit minus the given margin (which may be
	zero). If not, equality is allowed.
	<<Auto components: public>>=
	public :: constrain_mass_sum
	<<Auto components: types>>=
	type, extends (split_constraint_t) :: constraint_mass_sum
	private
	real(default) :: mass_limit = 0
	logical :: strictly_less = .false.
	real(default) :: margin = 0
	contains
	procedure :: check_before_record => constraint_mass_sum_check_before_record
	end type constraint_mass_sum

	@ %def contraint_mass_sum
	<<Auto components: sub interfaces>>=
	module function constrain_mass_sum (mass_limit, margin) result (c)
	real(default), intent(in) :: mass_limit
	real(default), intent(in), optional :: margin
	type(constraint_mass_sum) :: c
	end function constrain_mass_sum
	module subroutine constraint_mass_sum_check_before_record &
	(c, table, pl, n_loop, passed)
	class(constraint_mass_sum), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	end subroutine constraint_mass_sum_check_before_record
	<<Auto components: procedures>>=
	module function constrain_mass_sum (mass_limit, margin) result (c)
	real(default), intent(in) :: mass_limit
	real(default), intent(in), optional :: margin
	type(constraint_mass_sum) :: c
	c%mass_limit = mass_limit
	if (present (margin)) then
	c%strictly_less = .true.
	c%margin = margin
	end if
	end function constrain_mass_sum

	module subroutine constraint_mass_sum_check_before_record &
	(c, table, pl, n_loop, passed)
	class(constraint_mass_sum), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	real(default) :: limit
	if (c%strictly_less) then
	limit = c%mass_limit - c%margin
	select type (table)
	type is (if_table_t)
	passed = mass_sum (pl, 1, 2, table%model) < limit &
	.and. mass_sum (pl, 3, pl%get_size (), table%model) < limit
	class default
	passed = mass_sum (pl, 1, pl%get_size (), table%model) < limit
	end select
	else
	limit = c%mass_limit
	select type (table)
	type is (if_table_t)
	passed = mass_sum (pl, 1, 2, table%model) <= limit &
	.and. mass_sum (pl, 3, pl%get_size (), table%model) <= limit
	class default
	passed = mass_sum (pl, 1, pl%get_size (), table%model) <= limit
	end select
	end if
	end subroutine constraint_mass_sum_check_before_record

	@ %def constrain_mass_sum
	@ %def constraint_mass_sum_check_before_record
	@
	\subsubsection{Initial state particles}
	Specific constraint: The two incoming particles must both match the given
	particle list. This is checked for the generated particle list, just before
	it is recorded.
	<<Auto components: public>>=
	public :: constrain_in_state
	<<Auto components: types>>=
	type, extends (split_constraint_t) :: constraint_in_state
	private
	type(pdg_list_t) :: pl
	contains
	procedure :: check_before_record => constraint_in_state_check_before_record
	end type constraint_in_state

	@ %def constraint_in_state
	<<Auto components: sub interfaces>>=
	module function constrain_in_state (pl) result (c)
	type(pdg_list_t), intent(in) :: pl
	type(constraint_in_state) :: c
	end function constrain_in_state
	module subroutine constraint_in_state_check_before_record &
	(c, table, pl, n_loop, passed)
	class(constraint_in_state), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	end subroutine constraint_in_state_check_before_record
	<<Auto components: procedures>>=
	module function constrain_in_state (pl) result (c)
	type(pdg_list_t), intent(in) :: pl
	type(constraint_in_state) :: c
	c%pl = pl
	end function constrain_in_state

	module subroutine constraint_in_state_check_before_record &
	(c, table, pl, n_loop, passed)
	class(constraint_in_state), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	integer :: i
	select type (table)
	type is (if_table_t)
	passed = .false.
	do i = 1, 2
	if (.not. (c%pl .match. pl%get (i))) return
	end do
	end select
	passed = .true.
	end subroutine constraint_in_state_check_before_record

	@ %def constrain_in_state
	@ %def constraint_in_state_check_before_record
	@
	\subsubsection{Photon induced processes}
	If set, filter out photon induced processes.
	<<Auto components: public>>=
	public :: constrain_photon_induced_processes
	<<Auto components: types>>=
	type, extends (split_constraint_t) :: constraint_photon_induced_processes
	private
	integer :: n_in
	contains
	procedure :: check_before_record => &
	constraint_photon_induced_processes_check_before_record
	end type constraint_photon_induced_processes

	@ %def constraint_photon_induced_processes
	<<Auto components: sub interfaces>>=
	module function constrain_photon_induced_processes (n_in) result (c)
	integer, intent(in) :: n_in
	type(constraint_photon_induced_processes) :: c
	end function constrain_photon_induced_processes
	module subroutine constraint_photon_induced_processes_check_before_record &
	(c, table, pl, n_loop, passed)
	class(constraint_photon_induced_processes), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	end subroutine constraint_photon_induced_processes_check_before_record
	<<Auto components: procedures>>=
	module function constrain_photon_induced_processes (n_in) result (c)
	integer, intent(in) :: n_in
	type(constraint_photon_induced_processes) :: c
	c%n_in = n_in
	end function constrain_photon_induced_processes

	module subroutine constraint_photon_induced_processes_check_before_record &
	(c, table, pl, n_loop, passed)
	class(constraint_photon_induced_processes), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop
	logical, intent(out) :: passed
	integer :: i
	select type (table)
	type is (if_table_t)
	passed = .false.
	do i = 1, c%n_in
	if (pl%a(i)%get () == 22) return
	end do
	end select
	passed = .true.
	end subroutine constraint_photon_induced_processes_check_before_record

	@ %def constrain_photon_induced_processes
	@ %def constraint_photon_induced_processes_check_before_record
	@
	\subsubsection{Coupling constraint}
	Filters vertices which do not match the desired NLO pattern.
	<<Auto components: types>>=
	type, extends (split_constraint_t) :: constraint_coupling_t
	private
	logical :: qed = .false.
	logical :: qcd = .true.
	logical :: ew = .false.
	integer :: n_nlo_correction_types
	contains
	<<Auto components: constraint coupling: TBP>>
	end type constraint_coupling_t

	@ %def constraint_coupling_t
	@
	<<Auto components: public>>=
	public :: constrain_couplings
	<<Auto components: sub interfaces>>=
	module function constrain_couplings (qcd, qed, n_nlo_correction_types) result (c)
	type(constraint_coupling_t) :: c
	logical, intent(in) :: qcd, qed
	integer, intent(in) :: n_nlo_correction_types
	end function constrain_couplings
	<<Auto components: procedures>>=
	module function constrain_couplings (qcd, qed, n_nlo_correction_types) result (c)
	type(constraint_coupling_t) :: c
	logical, intent(in) :: qcd, qed
	integer, intent(in) :: n_nlo_correction_types
	c%qcd = qcd; c%qed = qed
	c%n_nlo_correction_types = n_nlo_correction_types
	end function constrain_couplings

	@ %def constrain_couplings
	@
	<<Auto components: constraint coupling: TBP>>=
	procedure :: check_before_insert => constraint_coupling_check_before_insert
	<<Auto components: sub interfaces>>=
	module subroutine constraint_coupling_check_before_insert (c, table, pa, pl, passed)
	class(constraint_coupling_t), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	end subroutine constraint_coupling_check_before_insert
	<<Auto components: procedures>>=
	module subroutine constraint_coupling_check_before_insert (c, table, pa, pl, passed)
	class(constraint_coupling_t), intent(in) :: c
	class(ps_table_t), intent(in) :: table
	type(pdg_array_t), intent(in) :: pa
	type(pdg_list_t), intent(inout) :: pl
	logical, intent(out) :: passed
	type(pdg_list_t) :: pl_vertex
	type(pdg_array_t) :: pdg_gluon, pdg_photon, pdg_W_Z, pdg_gauge_bosons
	integer :: i, j
	pdg_gluon = GLUON; pdg_photon = PHOTON
	pdg_W_Z = [W_BOSON,-W_BOSON, Z_BOSON]
	if (c%qcd) pdg_gauge_bosons = pdg_gauge_bosons // pdg_gluon
	if (c%qed) pdg_gauge_bosons = pdg_gauge_bosons // pdg_photon
	if (c%ew) pdg_gauge_bosons = pdg_gauge_bosons // pdg_W_Z
	do j = 1, pa%get_length ()
	call pl_vertex%init (pl%get_size () + 1)
	call pl_vertex%set (1, pa%get(j))
	do i = 1, pl%get_size ()
	call pl_vertex%set (i + 1, pl%get(i))
	end do
	if (pl_vertex%get_size () > 3) then
	passed = .false.
	cycle
	end if
	if (is_massless_vector(pa%get(j))) then
	if (.not. table%model%check_vertex &
	(pl_vertex%a(1)%get (), pl_vertex%a(2)%get (), pl_vertex%a(3)%get ())) then
	passed = .false.
	cycle
	end if
	else if (.not. table%model%check_vertex &
	(- pl_vertex%a(1)%get (), pl_vertex%a(2)%get (), pl_vertex%a(3)%get ())) then
	passed = .false.
	cycle
	end if
	if (.not. (pl_vertex .match. pdg_gauge_bosons)) then
	passed = .false.
	cycle
	end if
	passed = .true.
	exit
	end do
	end subroutine constraint_coupling_check_before_insert

	@ %def constraint_coupling_check_before_insert
	@
	\subsection{Tables of states}
	Automatically generate a list of possible process components for a given
	initial set (a single massive particle or a preset list of states).

	The set of process components are generated by recursive splitting, applying
	constraints on the fly that control and limit the process. The generated
	states are accumulated in a table that we can read out after completion.
	<<Auto components: types>>=
	type, extends (pdg_list_t) :: ps_entry_t
	integer :: n_loop = 0
	integer :: n_rad = 0
	type(ps_entry_t), pointer :: previous => null ()
	type(ps_entry_t), pointer :: next => null ()
	end type ps_entry_t

	@ %def ps_entry_t
	@
	<<Auto components: parameters>>=
	integer, parameter :: PROC_UNDEFINED = 0
	integer, parameter :: PROC_DECAY = 1
	integer, parameter :: PROC_SCATTER = 2

	@ %def auto_components parameters
	@ This is the wrapper type for the decay tree for the list of final
	states and the final array. First, an abstract base type:
	<<Auto components: public>>=
	public :: ps_table_t
	<<Auto components: types>>=
	type, abstract :: ps_table_t
	private
	class(model_data_t), pointer :: model => null ()
	logical :: loops = .false.
	type(ps_entry_t), pointer :: first => null ()
	type(ps_entry_t), pointer :: last => null ()
	integer :: proc_type
	contains
	<<Auto components: ps table: TBP>>
	end type ps_table_t

	@ %def ps_table_t
	@ The extensions: one for decay, one for generic final states. The decay-state
	table stores the initial particle. The final-state table is
	indifferent, and the initial/final state table treats the first two
	particles in its list as incoming antiparticles.
	<<Auto components: public>>=
	public :: ds_table_t
	public :: fs_table_t
	public :: if_table_t
	<<Auto components: types>>=
	type, extends (ps_table_t) :: ds_table_t
	private
	integer :: pdg_in = 0
	contains
	<<Auto components: ds table: TBP>>
	end type ds_table_t

	type, extends (ps_table_t) :: fs_table_t
	contains
	<<Auto components: fs table: TBP>>
	end type fs_table_t

	type, extends (fs_table_t) :: if_table_t
	contains
	<<Auto components: if table: TBP>>
	end type if_table_t

	@ %def ds_table_t fs_table_t if_table_t
	@ Finalizer: we must deallocate the embedded list.
	<<Auto components: ps table: TBP>>=
	procedure :: final => ps_table_final
	<<Auto components: sub interfaces>>=
	module subroutine ps_table_final (object)
	class(ps_table_t), intent(inout) :: object
	end subroutine ps_table_final
	<<Auto components: procedures>>=
	module subroutine ps_table_final (object)
	class(ps_table_t), intent(inout) :: object
	type(ps_entry_t), pointer :: current
	do while (associated (object%first))
	current => object%first
	object%first => current%next
	deallocate (current)
	end do
	nullify (object%last)
	end subroutine ps_table_final

	@ %def ps_table_final
	@ Write the table. A base writer for the body and specific writers
	for the headers.
	<<Auto components: ps table: TBP>>=
	procedure :: base_write => ps_table_base_write
	procedure (ps_table_write), deferred :: write
	<<Auto components: interfaces>>=
	interface
	subroutine ps_table_write (object, unit)
	import
	class(ps_table_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine ps_table_write
	end interface
	<<Auto components: ds table: TBP>>=
	procedure :: write => ds_table_write
	<<Auto components: fs table: TBP>>=
	procedure :: write => fs_table_write
	<<Auto components: if table: TBP>>=
	procedure :: write => if_table_write
	@ The first [[n_in]] particles will be replaced by antiparticles in
	the output, and we write an arrow if [[n_in]] is present.
	<<Auto components: sub interfaces>>=
	module subroutine ps_table_base_write (object, unit, n_in)
	class(ps_table_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: n_in
	end subroutine ps_table_base_write
	module subroutine ds_table_write (object, unit)
	class(ds_table_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine ds_table_write
	module subroutine fs_table_write (object, unit)
	class(fs_table_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine fs_table_write
	module subroutine if_table_write (object, unit)
	class(if_table_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine if_table_write
	<<Auto components: procedures>>=
	module subroutine ps_table_base_write (object, unit, n_in)
	class(ps_table_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: n_in
	integer, dimension(:), allocatable :: pdg
	type(ps_entry_t), pointer :: entry
	type(field_data_t), pointer :: prt
	integer :: u, i, j, n0
	u = given_output_unit (unit)
	entry => object%first
	do while (associated (entry))
	write (u, "(2x)", advance = "no")
	if (present (n_in)) then
	do i = 1, n_in
	write (u, "(1x)", advance = "no")
	pdg = entry%get (i)
	do j = 1, size (pdg)
	prt => object%model%get_field_ptr (pdg(j))
	if (j > 1) write (u, "(':')", advance = "no")
	write (u, "(A)", advance = "no") &
	char (prt%get_name (pdg(j) >= 0))
	end do
	end do
	write (u, "(1x,A)", advance = "no") "=>"
	n0 = n_in + 1
	else
	n0 = 1
	end if
	do i = n0, entry%get_size ()
	write (u, "(1x)", advance = "no")
	pdg = entry%get (i)
	do j = 1, size (pdg)
	prt => object%model%get_field_ptr (pdg(j))
	if (j > 1) write (u, "(':')", advance = "no")
	write (u, "(A)", advance = "no") &
	char (prt%get_name (pdg(j) < 0))
	end do
	end do
	if (object%loops) then
	write (u, "(2x,'[',I0,',',I0,']')") entry%n_loop, entry%n_rad
	else
	write (u, "(A)")
	end if
	entry => entry%next
	end do
	end subroutine ps_table_base_write

	module subroutine ds_table_write (object, unit)
	class(ds_table_t), intent(in) :: object
	integer, intent(in), optional :: unit
	type(field_data_t), pointer :: prt
	integer :: u
	u = given_output_unit (unit)
	prt => object%model%get_field_ptr (object%pdg_in)
	write (u, "(1x,A,1x,A)") "Decays for particle:", &
	char (prt%get_name (object%pdg_in < 0))
	call object%base_write (u)
	end subroutine ds_table_write

	module subroutine fs_table_write (object, unit)
	class(fs_table_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Table of final states:"
	call object%base_write (u)
	end subroutine fs_table_write

	module subroutine if_table_write (object, unit)
	class(if_table_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Table of in/out states:"
	select case (object%proc_type)
	case (PROC_DECAY)
	call object%base_write (u, n_in = 1)
	case (PROC_SCATTER)
	call object%base_write (u, n_in = 2)
	end select
	end subroutine if_table_write

	@ %def ps_table_write ds_table_write fs_table_write
	@ Obtain a particle string for a given index in the pdg list
	<<Auto components: ps table: TBP>>=
	procedure :: get_particle_string => ps_table_get_particle_string
	<<Auto components: sub interfaces>>=
	module subroutine ps_table_get_particle_string (object, index, prt_in, prt_out)
	class(ps_table_t), intent(in) :: object
	integer, intent(in) :: index
	type(string_t), intent(out), dimension(:), allocatable :: prt_in, prt_out
	end subroutine ps_table_get_particle_string
	<<Auto components: procedures>>=
	module subroutine ps_table_get_particle_string (object, index, prt_in, prt_out)
	class(ps_table_t), intent(in) :: object
	integer, intent(in) :: index
	type(string_t), intent(out), dimension(:), allocatable :: prt_in, prt_out
	integer :: n_in
	type(field_data_t), pointer :: prt
	type(ps_entry_t), pointer :: entry
	integer, dimension(:), allocatable :: pdg
	integer :: n0
	integer :: i, j
	entry => object%first
	i = 1
	do while (i < index)
	if (associated (entry%next)) then
	entry => entry%next
	i = i + 1
	else
	call msg_fatal ("ps_table: entry with requested index does not exist!")
	end if
	end do

	if (object%proc_type > 0) then
	select case (object%proc_type)
	case (PROC_DECAY)
	n_in = 1
	case (PROC_SCATTER)
	n_in = 2
	end select
	else
	call msg_fatal ("Neither decay nor scattering process")
	end if

	n0 = n_in + 1
	allocate (prt_in (n_in), prt_out (entry%get_size () - n_in))
	do i = 1, n_in
	prt_in(i) = ""
	pdg = entry%get(i)
	do j = 1, size (pdg)
	prt => object%model%get_field_ptr (pdg(j))
	prt_in(i) = prt_in(i) // prt%get_name (pdg(j) >= 0)
	if (j /= size (pdg)) prt_in(i) = prt_in(i) // ":"
	end do
	end do
	do i = n0, entry%get_size ()
	prt_out(i-n_in) = ""
	pdg = entry%get(i)
	do j = 1, size (pdg)
	prt => object%model%get_field_ptr (pdg(j))
	prt_out(i-n_in) = prt_out(i-n_in) // prt%get_name (pdg(j) < 0)
	if (j /= size (pdg)) prt_out(i-n_in) = prt_out(i-n_in) // ":"
	end do
	end do
	end subroutine ps_table_get_particle_string

	@ %def ps_table_get_particle_string
	@ Initialize with a predefined set of final states, or in/out state lists.
	<<Auto components: ps table: TBP>>=
	generic :: init => ps_table_init
	procedure, private :: ps_table_init
	<<Auto components: if table: TBP>>=
	generic :: init => if_table_init
	procedure, private :: if_table_init
	<<Auto components: sub interfaces>>=
	module subroutine ps_table_init &
	(table, model, pl, constraints, n_in, do_not_check_regular)
	class(ps_table_t), intent(out) :: table
	class(model_data_t), intent(in), target :: model
	type(pdg_list_t), dimension(:), intent(in) :: pl
	type(split_constraints_t), intent(in) :: constraints
	integer, intent(in), optional :: n_in
	logical, intent(in), optional :: do_not_check_regular
	end subroutine ps_table_init
	module subroutine if_table_init (table, model, pl_in, pl_out, constraints)
	class(if_table_t), intent(out) :: table
	class(model_data_t), intent(in), target :: model
	type(pdg_list_t), dimension(:), intent(in) :: pl_in, pl_out
	type(split_constraints_t), intent(in) :: constraints
	end subroutine if_table_init
	<<Auto components: procedures>>=
	module subroutine ps_table_init &
	(table, model, pl, constraints, n_in, do_not_check_regular)
	class(ps_table_t), intent(out) :: table
	class(model_data_t), intent(in), target :: model
	type(pdg_list_t), dimension(:), intent(in) :: pl
	type(split_constraints_t), intent(in) :: constraints
	integer, intent(in), optional :: n_in
	logical, intent(in), optional :: do_not_check_regular
	logical :: passed
	integer :: i
	table%model => model

	if (present (n_in)) then
	select case (n_in)
	case (1)
	table%proc_type = PROC_DECAY
	case (2)
	table%proc_type = PROC_SCATTER
	case default
	table%proc_type = PROC_UNDEFINED
	end select
	else
	table%proc_type = PROC_UNDEFINED
	end if

	do i = 1, size (pl)
	call table%record (pl(i), 0, 0, constraints, &
	do_not_check_regular, passed)
	if (.not. passed) then
	call msg_fatal ("ps_table: Registering process components failed")
	end if
	end do
	end subroutine ps_table_init

	module subroutine if_table_init (table, model, pl_in, pl_out, constraints)
	class(if_table_t), intent(out) :: table
	class(model_data_t), intent(in), target :: model
	type(pdg_list_t), dimension(:), intent(in) :: pl_in, pl_out
	type(split_constraints_t), intent(in) :: constraints
	integer :: i, j, k, p, n_in, n_out
	type(pdg_array_t), dimension(:), allocatable :: pa_in
	type(pdg_list_t), dimension(:), allocatable :: pl
	allocate (pl (size (pl_in) * size (pl_out)))
	k = 0
	do i = 1, size (pl_in)
	n_in = pl_in(i)%get_size ()
	allocate (pa_in (n_in))
	do p = 1, n_in
	pa_in(p) = pl_in(i)%get (p)
	end do
	do j = 1, size (pl_out)
	n_out = pl_out(j)%get_size ()
	k = k + 1
	call pl(k)%init (n_in + n_out)
	do p = 1, n_in
	call pl(k)%set (p, invert_pdg_array (pa_in(p), model))
	end do
	do p = 1, n_out
	call pl(k)%set (n_in + p, pl_out(j)%get (p))
	end do
	end do
	deallocate (pa_in)
	end do
	n_in = size (pl_in(1)%a)
	call table%init (model, pl, constraints, n_in, do_not_check_regular = .true.)
	end subroutine if_table_init

	@ %def ps_table_init if_table_init
	@ Enable loops for the table. This affects both splitting and output.
	<<Auto components: ps table: TBP>>=
	procedure :: enable_loops => ps_table_enable_loops
	<<Auto components: sub interfaces>>=
	module subroutine ps_table_enable_loops (table)
	class(ps_table_t), intent(inout) :: table
	end subroutine ps_table_enable_loops
	<<Auto components: procedures>>=
	module subroutine ps_table_enable_loops (table)
	class(ps_table_t), intent(inout) :: table
	table%loops = .true.
	end subroutine ps_table_enable_loops

	@ %def ps_table_enable_loops
	@
	\subsection{Top-level methods}
	Create a table for a single-particle decay. Construct all possible final
	states from a single particle with PDG code [[pdg_in]]. The construction is
	limited by the given [[constraints]].
	<<Auto components: ds table: TBP>>=
	procedure :: make => ds_table_make
	<<Auto components: sub interfaces>>=
	module subroutine ds_table_make (table, model, pdg_in, constraints)
	class(ds_table_t), intent(out) :: table
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: pdg_in
	type(split_constraints_t), intent(in) :: constraints
	end subroutine ds_table_make
	<<Auto components: procedures>>=
	module subroutine ds_table_make (table, model, pdg_in, constraints)
	class(ds_table_t), intent(out) :: table
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: pdg_in
	type(split_constraints_t), intent(in) :: constraints
	type(pdg_list_t) :: pl_in
	type(pdg_list_t), dimension(0) :: pl
	call table%init (model, pl, constraints)
	table%pdg_in = pdg_in
	call pl_in%init (1)
	call pl_in%set (1, [pdg_in])
	call table%split (pl_in, 0, constraints)
	end subroutine ds_table_make

	@ %def ds_table_make
	@ Split all entries in a growing table, starting from a table that may already
	contain states. Add and record split states on the fly.
	<<Auto components: fs table: TBP>>=
	procedure :: radiate => fs_table_radiate
	<<Auto components: sub interfaces>>=
	module subroutine fs_table_radiate (table, constraints, do_not_check_regular)
	class(fs_table_t), intent(inout) :: table
	type(split_constraints_t) :: constraints
	logical, intent(in), optional :: do_not_check_regular
	end subroutine fs_table_radiate
	<<Auto components: procedures>>=
	module subroutine fs_table_radiate (table, constraints, do_not_check_regular)
	class(fs_table_t), intent(inout) :: table
	type(split_constraints_t) :: constraints
	logical, intent(in), optional :: do_not_check_regular
	type(ps_entry_t), pointer :: current
	current => table%first
	do while (associated (current))
	call table%split (current, 0, constraints, record = .true., &
	do_not_check_regular = do_not_check_regular)
	current => current%next
	end do
	end subroutine fs_table_radiate

	@ %def fs_table_radiate
	@
	\subsection{Splitting algorithm}
	Recursive splitting. First of all, we record the current [[pdg_list]] in
	the table, subject to [[constraints]], if requested. We also record copies of
	the list marked as loop corrections.

	When we record a particle list, we sort it first.

	If there is room for splitting, We take a PDG array list and the index of an
	element, and split this element in all possible ways. The split entry is
	inserted into the list, which we split further.

	The recursion terminates whenever the split array would have a length
	greater than $n_\text{max}$.
	<<Auto components: ps table: TBP>>=
	procedure :: split => ps_table_split
	<<Auto components: sub interfaces>>=
	recursive module subroutine ps_table_split (table, pl, n_rad, constraints, &
	record, do_not_check_regular)
	class(ps_table_t), intent(inout) :: table
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_rad
	type(split_constraints_t), intent(in) :: constraints
	logical, intent(in), optional :: record, do_not_check_regular
	end subroutine ps_table_split
	<<Auto components: procedures>>=
	recursive module subroutine ps_table_split (table, pl, n_rad, constraints, &
	record, do_not_check_regular)
	class(ps_table_t), intent(inout) :: table
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_rad
	type(split_constraints_t), intent(in) :: constraints
	logical, intent(in), optional :: record, do_not_check_regular
	integer :: n_loop, i
	logical :: passed, save_pdg_index
	type(vertex_iterator_t) :: vit
	integer, dimension(:), allocatable :: pdg1
	integer, dimension(:), allocatable :: pdg2
	if (present (record)) then
	if (record) then
	n_loop = 0
	INCR_LOOPS: do
	call table%record_sorted (pl, n_loop, n_rad, constraints, &
	do_not_check_regular, passed)
	if (.not. passed) exit INCR_LOOPS
	if (.not. table%loops) exit INCR_LOOPS
	n_loop = n_loop + 1
	end do INCR_LOOPS
	end if
	end if
	select type (table)
	type is (if_table_t)
	save_pdg_index = .true.
	class default
	save_pdg_index = .false.
	end select
	do i = 1, pl%get_size ()
	call constraints%check_before_split (table, pl, i, passed)
	if (passed) then
	pdg1 = pl%get (i)
	call vit%init (table%model, pdg1, save_pdg_index)
	SCAN_VERTICES: do
	call vit%get_next_match (pdg2)
	if (allocated (pdg2)) then
	call table%insert (pl, n_rad, i, pdg2, constraints, &
	do_not_check_regular = do_not_check_regular)
	else
	exit SCAN_VERTICES
	end if
	end do SCAN_VERTICES
	end if
	end do
	end subroutine ps_table_split

	@ %def ps_table_split
	@ The worker part: insert the list of particles found by vertex matching in
	place of entry [[i]] in the PDG list. Then split/record further.

	The [[n_in]] parameter tells the replacement routine to insert the new
	particles after entry [[n_in]]. Otherwise, they follow index [[i]].
	<<Auto components: ps table: TBP>>=
	procedure :: insert => ps_table_insert
	<<Auto components: sub interfaces>>=
	recursive module subroutine ps_table_insert &
	(table, pl, n_rad, i, pdg, constraints, n_in, do_not_check_regular)
	class(ps_table_t), intent(inout) :: table
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_rad, i
	integer, dimension(:), intent(in) :: pdg
	type(split_constraints_t), intent(in) :: constraints
	integer, intent(in), optional :: n_in
	logical, intent(in), optional :: do_not_check_regular
	end subroutine ps_table_insert
	<<Auto components: procedures>>=
	recursive module subroutine ps_table_insert &
	(table, pl, n_rad, i, pdg, constraints, n_in, do_not_check_regular)
	class(ps_table_t), intent(inout) :: table
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_rad, i
	integer, dimension(:), intent(in) :: pdg
	type(split_constraints_t), intent(in) :: constraints
	integer, intent(in), optional :: n_in
	logical, intent(in), optional :: do_not_check_regular
	type(pdg_list_t) :: pl_insert
	logical :: passed
	integer :: k, s
	s = size (pdg)
	call pl_insert%init (s)
	do k = 1, s
	call pl_insert%set (k, pdg(k))
	end do
	call constraints%check_before_insert (table, pl%get (i), pl_insert, passed)
	if (passed) then
	if (.not. is_colored_isr ()) return
	call table%split (pl%replace (i, pl_insert, n_in), n_rad + s - 1, &
	constraints, record = .true., do_not_check_regular = .true.)
	end if
	contains
	logical function is_colored_isr () result (ok)
	type(pdg_list_t) :: pl_replaced
	ok = .true.
	if (present (n_in)) then
	if (i <= n_in) then
	ok = pl_insert%contains_colored_particles ()
	if (.not. ok) then
	pl_replaced = pl%replace (i, pl_insert, n_in)
	associate (size_replaced => pl_replaced%get_pdg_sizes (), &
	size => pl%get_pdg_sizes ())
	ok = all (size_replaced(:n_in) == size(:n_in))
	end associate
	end if
	end if
	end if
	end function is_colored_isr
	end subroutine ps_table_insert

	@ %def ps_table_insert
	@ Special case:
	If we are splitting an initial particle, there is slightly more to
	do. We loop over the particles from the vertex match and replace the
	initial particle by each of them in turn. The remaining particles
	must be appended after the second initial particle, so they will end
	up in the out state. This is done by providing the [[n_in]] argument
	to the base method as an optional argument.

	Note that we must call the base-method procedure explicitly, so the
	[[table]] argument keeps its dynamic type as [[if_table]] inside this
	procedure.
	<<Auto components: if table: TBP>>=
	procedure :: insert => if_table_insert
	<<Auto components: sub interfaces>>=
	recursive module subroutine if_table_insert &
	(table, pl, n_rad, i, pdg, constraints, n_in, do_not_check_regular)
	class(if_table_t), intent(inout) :: table
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_rad, i
	integer, dimension(:), intent(in) :: pdg
	type(split_constraints_t), intent(in) :: constraints
	integer, intent(in), optional :: n_in
	logical, intent(in), optional :: do_not_check_regular
	end subroutine if_table_insert
	<<Auto components: procedures>>=
	recursive module subroutine if_table_insert &
	(table, pl, n_rad, i, pdg, constraints, n_in, do_not_check_regular)
	class(if_table_t), intent(inout) :: table
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_rad, i
	integer, dimension(:), intent(in) :: pdg
	type(split_constraints_t), intent(in) :: constraints
	integer, intent(in), optional :: n_in
	logical, intent(in), optional :: do_not_check_regular
	integer, dimension(:), allocatable :: pdg_work
	integer :: p
	if (i > 2) then
	call ps_table_insert (table, pl, n_rad, i, pdg, constraints, &
	do_not_check_regular = do_not_check_regular)
	else
	allocate (pdg_work (size (pdg)))
	do p = 1, size (pdg)
	pdg_work(1) = pdg(p)
	pdg_work(2:p) = pdg(1:p-1)
	pdg_work(p+1:) = pdg(p+1:)
	select case (table%proc_type)
	case (PROC_DECAY)
	call ps_table_insert (table, &
	pl, n_rad, i, pdg_work, constraints, n_in = 1, &
	do_not_check_regular = do_not_check_regular)
	case (PROC_SCATTER)
	call ps_table_insert (table, &
	pl, n_rad, i, pdg_work, constraints, n_in = 2, &
	do_not_check_regular = do_not_check_regular)
	end select
	end do
	end if
	end subroutine if_table_insert

	@ %def if_table_insert
	@ Sort before recording. In the case of the [[if_table]], we do not
	sort the first [[n_in]] particle entries. Instead, we check whether they are
	allowed in the [[pl_beam]] PDG list, if that is provided.
	<<Auto components: ps table: TBP>>=
	procedure :: record_sorted => ps_table_record_sorted
	<<Auto components: if table: TBP>>=
	procedure :: record_sorted => if_table_record_sorted
	<<Auto components: sub interfaces>>=
	module subroutine ps_table_record_sorted &
	(table, pl, n_loop, n_rad, constraints, do_not_check_regular, passed)
	class(ps_table_t), intent(inout) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop, n_rad
	type(split_constraints_t), intent(in) :: constraints
	logical, intent(in), optional :: do_not_check_regular
	logical, intent(out) :: passed
	end subroutine ps_table_record_sorted
	module subroutine if_table_record_sorted &
	(table, pl, n_loop, n_rad, constraints, do_not_check_regular, passed)
	class(if_table_t), intent(inout) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop, n_rad
	type(split_constraints_t), intent(in) :: constraints
	logical, intent(in), optional :: do_not_check_regular
	logical, intent(out) :: passed
	end subroutine if_table_record_sorted
	<<Auto components: procedures>>=
	module subroutine ps_table_record_sorted &
	(table, pl, n_loop, n_rad, constraints, do_not_check_regular, passed)
	class(ps_table_t), intent(inout) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop, n_rad
	type(split_constraints_t), intent(in) :: constraints
	logical, intent(in), optional :: do_not_check_regular
	logical, intent(out) :: passed
	call table%record (pl%sort_abs (), n_loop, n_rad, constraints, &
	do_not_check_regular, passed)
	end subroutine ps_table_record_sorted

	module subroutine if_table_record_sorted &
	(table, pl, n_loop, n_rad, constraints, do_not_check_regular, passed)
	class(if_table_t), intent(inout) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop, n_rad
	type(split_constraints_t), intent(in) :: constraints
	logical, intent(in), optional :: do_not_check_regular
	logical, intent(out) :: passed
	call table%record (pl%sort_abs (2), n_loop, n_rad, constraints, &
	do_not_check_regular, passed)
	end subroutine if_table_record_sorted

	@ %def ps_table_record_sorted if_table_record_sorted
	@ Record an entry: insert into the list. Check the ordering and
	insert it at the correct place, unless it is already there.

	We record an array only if its mass sum is less than the total
	available energy. This restriction is removed by setting
	[[constrained]] to false.
	<<Auto components: ps table: TBP>>=
	procedure :: record => ps_table_record
	<<Auto components: sub interfaces>>=
	module subroutine ps_table_record (table, pl, n_loop, n_rad, constraints, &
	do_not_check_regular, passed)
	class(ps_table_t), intent(inout) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop, n_rad
	type(split_constraints_t), intent(in) :: constraints
	logical, intent(in), optional :: do_not_check_regular
	logical, intent(out) :: passed
	end subroutine ps_table_record
	<<Auto components: procedures>>=
	module subroutine ps_table_record (table, pl, n_loop, n_rad, constraints, &
	do_not_check_regular, passed)
	class(ps_table_t), intent(inout) :: table
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n_loop, n_rad
	type(split_constraints_t), intent(in) :: constraints
	logical, intent(in), optional :: do_not_check_regular
	logical, intent(out) :: passed
	type(ps_entry_t), pointer :: current
	logical :: needs_check
	passed = .false.
	needs_check = .true.
	if (present (do_not_check_regular)) needs_check = .not. do_not_check_regular
	if (needs_check .and. .not. pl%is_regular ()) then
	call msg_warning ("Record ps_table entry: Irregular pdg-list encountered!")
	return
	end if
	call constraints%check_before_record (table, pl, n_loop, passed)
	if (.not. passed) then
	return
	end if
	current => table%first
	do while (associated (current))
	if (pl == current) then
	if (n_loop == current%n_loop) return
	else if (pl < current) then
	call record_insert ()
	return
	end if
	current => current%next
	end do
	call record_insert ()
	contains
	subroutine record_insert ()
	type(ps_entry_t), pointer :: entry
	allocate (entry)
	entry%pdg_list_t = pl
	entry%n_loop = n_loop
	entry%n_rad = n_rad
	if (associated (current)) then
	if (associated (current%previous)) then
	current%previous%next => entry
	entry%previous => current%previous
	else
	table%first => entry
	end if
	entry%next => current
	current%previous => entry
	else
	if (associated (table%last)) then
	table%last%next => entry
	entry%previous => table%last
	else
	table%first => entry
	end if
	table%last => entry
	end if
	end subroutine record_insert
	end subroutine ps_table_record

	@ %def ps_table_record
	@
	\subsection{Tools}
	Compute the mass sum for a PDG list object, counting the entries with indices
	between (including) [[n1]] and [[n2]]. Rely on the requirement that
	if an entry is a PDG array, this array must be degenerate in mass.
	<<Auto components: procedures>>=
	function mass_sum (pl, n1, n2, model) result (m)
	type(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: n1, n2
	class(model_data_t), intent(in), target :: model
	integer, dimension(:), allocatable :: pdg
	real(default) :: m
	type(field_data_t), pointer :: prt
	integer :: i
	m = 0
	do i = n1, n2
	pdg = pl%get (i)
	prt => model%get_field_ptr (pdg(1))
	m = m + prt%get_mass ()
	end do
	end function mass_sum

	@ %def mass_sum
	@ Invert a PDG array, replacing particles by antiparticles. This
	depends on the model.
	<<Auto components: procedures>>=
	function invert_pdg_array (pa, model) result (pa_inv)
	type(pdg_array_t), intent(in) :: pa
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t) :: pa_inv
	type(field_data_t), pointer :: prt
	integer :: i, pdg
	pa_inv = pa
	do i = 1, pa_inv%get_length ()
	pdg = pa_inv%get (i)
	prt => model%get_field_ptr (pdg)
	if (prt%has_antiparticle ()) call pa_inv%set (i, -pdg)
	end do
	end function invert_pdg_array

	@ %def invert_pdg_array
	@
	\subsection{Access results}
	Return the number of generated decays.
	<<Auto components: ps table: TBP>>=
	procedure :: get_length => ps_table_get_length
	<<Auto components: sub interfaces>>=
	module function ps_table_get_length (ps_table) result (n)
	class(ps_table_t), intent(in) :: ps_table
	integer :: n
	end function ps_table_get_length
	<<Auto components: procedures>>=
	module function ps_table_get_length (ps_table) result (n)
	class(ps_table_t), intent(in) :: ps_table
	integer :: n
	type(ps_entry_t), pointer :: entry
	n = 0
	entry => ps_table%first
	do while (associated (entry))
	n = n + 1
	entry => entry%next
	end do
	end function ps_table_get_length

	@ %def ps_table_get_length
	@
	<<Auto components: ps table: TBP>>=
	procedure :: get_emitters => ps_table_get_emitters
	<<Auto components: sub interfaces>>=
	module subroutine ps_table_get_emitters (table, constraints, emitters)
	class(ps_table_t), intent(in) :: table
	type(split_constraints_t), intent(in) :: constraints
	integer, dimension(:), allocatable, intent(out) :: emitters
	end subroutine ps_table_get_emitters
	<<Auto components: procedures>>=
	module subroutine ps_table_get_emitters (table, constraints, emitters)
	class(ps_table_t), intent(in) :: table
	type(split_constraints_t), intent(in) :: constraints
	integer, dimension(:), allocatable, intent(out) :: emitters
	class(pdg_list_t), pointer :: pl
	integer :: i
	logical :: passed
	type(vertex_iterator_t) :: vit
	integer, dimension(:), allocatable :: pdg1, pdg2
	integer :: n_emitters
	integer, dimension(:), allocatable :: emitters_tmp
	integer, parameter :: buf0 = 6
	n_emitters = 0
	pl => table%first
	allocate (emitters_tmp (buf0))
	do i = 1, pl%get_size ()
	call constraints%check_before_split (table, pl, i, passed)
	if (passed) then
	pdg1 = pl%get(i)
	call vit%init (table%model, pdg1, .false.)
	do
	call vit%get_next_match(pdg2)
	if (allocated (pdg2)) then
	if (n_emitters + 1 > size (emitters_tmp)) &
	call extend_integer_array (emitters_tmp, 10)
	emitters_tmp (n_emitters + 1) = pdg1(1)
	n_emitters = n_emitters + 1
	else
	exit
	end if
	end do
	end if
	end do
	allocate (emitters (n_emitters))
	emitters = emitters_tmp (1:n_emitters)
	deallocate (emitters_tmp)
	end subroutine ps_table_get_emitters

	@ %def ps_table_get_emitters
	@ Return an allocated array of decay products (PDG codes). If
	requested, return also the loop and radiation order count.
	<<Auto components: ps table: TBP>>=
	procedure :: get_pdg_out => ps_table_get_pdg_out
	<<Auto components: sub interfaces>>=
	module subroutine ps_table_get_pdg_out (ps_table, i, pa_out, n_loop, n_rad)
	class(ps_table_t), intent(in) :: ps_table
	integer, intent(in) :: i
	type(pdg_array_t), dimension(:), allocatable, intent(out) :: pa_out
	integer, intent(out), optional :: n_loop, n_rad
	end subroutine ps_table_get_pdg_out
	<<Auto components: procedures>>=
	module subroutine ps_table_get_pdg_out (ps_table, i, pa_out, n_loop, n_rad)
	class(ps_table_t), intent(in) :: ps_table
	integer, intent(in) :: i
	type(pdg_array_t), dimension(:), allocatable, intent(out) :: pa_out
	integer, intent(out), optional :: n_loop, n_rad
	type(ps_entry_t), pointer :: entry
	integer :: n, j
	n = 0
	entry => ps_table%first
	FIND_ENTRY: do while (associated (entry))
	n = n + 1
	if (n == i) then
	allocate (pa_out (entry%get_size ()))
	do j = 1, entry%get_size ()
	pa_out(j) = entry%get (j)
	if (present (n_loop)) n_loop = entry%n_loop
	if (present (n_rad)) n_rad = entry%n_rad
	end do
	exit FIND_ENTRY
	end if
	entry => entry%next
	end do FIND_ENTRY
	end subroutine ps_table_get_pdg_out

	@ %def ps_table_get_pdg_out
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[auto_components_ut.f90]]>>=
	<<File header>>

	module auto_components_ut
	use unit_tests
	use auto_components_uti

	<<Standard module head>>

	<<Auto components: public test>>

	contains

	<<Auto components: test driver>>

	end module auto_components_ut
	@ %def auto_components_ut
	@
	<<[[auto_components_uti.f90]]>>=
	<<File header>>

	module auto_components_uti

	<<Use kinds>>
	<<Use strings>>
	use pdg_arrays
	use model_data
	use model_testbed, only: prepare_model, cleanup_model

	use auto_components

	<<Standard module head>>

	<<Auto components: test declarations>>

	contains

	<<Auto components: tests>>

	end module auto_components_uti
	@ %def auto_components_ut
	@ API: driver for the unit tests below.
	<<Auto components: public test>>=
	public :: auto_components_test
	<<Auto components: test driver>>=
	subroutine auto_components_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Auto components: execute tests>>
	end subroutine auto_components_test

	@ %def auto_components_tests
	@
	\subsubsection{Generate Decay Table}
	Determine all kinematically allowed decay channels for a Higgs boson,
	using default parameter values.
	<<Auto components: execute tests>>=
	call test (auto_components_1, "auto_components_1", &
	"generate decay table", &
	u, results)
	<<Auto components: test declarations>>=
	public :: auto_components_1
	<<Auto components: tests>>=
	subroutine auto_components_1 (u)
	integer, intent(in) :: u
	class(model_data_t), pointer :: model
	type(field_data_t), pointer :: prt
	type(ds_table_t) :: ds_table
	type(split_constraints_t) :: constraints

	write (u, "(A)") "* Test output: auto_components_1"
	write (u, "(A)") "* Purpose: determine Higgs decay table"
	write (u, *)

	write (u, "(A)") "* Read Standard Model"

	model => null ()
	call prepare_model (model, var_str ("SM"))

	prt => model%get_field_ptr (25)

	write (u, *)
	write (u, "(A)") "* Higgs decays n = 2"
	write (u, *)

	call constraints%init (2)
	call constraints%set (1, constrain_n_tot (2))
	call constraints%set (2, constrain_mass_sum (prt%get_mass ()))

	call ds_table%make (model, 25, constraints)
	call ds_table%write (u)
	call ds_table%final ()

	write (u, *)
	write (u, "(A)") "* Higgs decays n = 3 (w/o radiative)"
	write (u, *)

	call constraints%init (3)
	call constraints%set (1, constrain_n_tot (3))
	call constraints%set (2, constrain_mass_sum (prt%get_mass ()))
	call constraints%set (3, constrain_radiation ())

	call ds_table%make (model, 25, constraints)
	call ds_table%write (u)
	call ds_table%final ()

	write (u, *)
	write (u, "(A)") "* Higgs decays n = 3 (w/ radiative)"
	write (u, *)

	call constraints%init (2)
	call constraints%set (1, constrain_n_tot (3))
	call constraints%set (2, constrain_mass_sum (prt%get_mass ()))

	call ds_table%make (model, 25, constraints)
	call ds_table%write (u)
	call ds_table%final ()

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call cleanup_model (model)
	deallocate (model)

	write (u, *)
	write (u, "(A)") "* Test output end: auto_components_1"

	end subroutine auto_components_1

	@ %def auto_components_1
	@
	\subsubsection{Generate radiation}
	Given a final state, add radiation (NLO and NNLO). We provide a list
	of particles that is allowed to occur in the generated final states.
	<<Auto components: execute tests>>=
	call test (auto_components_2, "auto_components_2", &
	"generate NLO corrections, final state", &
	u, results)
	<<Auto components: test declarations>>=
	public :: auto_components_2
	<<Auto components: tests>>=
	subroutine auto_components_2 (u)
	integer, intent(in) :: u
	class(model_data_t), pointer :: model
	type(pdg_list_t), dimension(:), allocatable :: pl, pl_zzh
	type(pdg_list_t) :: pl_match
	type(fs_table_t) :: fs_table
	type(split_constraints_t) :: constraints
	real(default) :: sqrts
	integer :: i

	write (u, "(A)") "* Test output: auto_components_2"
	write (u, "(A)") "* Purpose: generate radiation (NLO)"
	write (u, *)


	write (u, "(A)") "* Read Standard Model"

	model => null ()
	call prepare_model (model, var_str ("SM"))

	write (u, *)
	write (u, "(A)") "* LO final state"
	write (u, *)

	allocate (pl (2))
	call pl(1)%init (2)
	call pl(1)%set (1, 1)
	call pl(1)%set (2, -1)
	call pl(2)%init (2)
	call pl(2)%set (1, 21)
	call pl(2)%set (2, 21)
	do i = 1, 2
	call pl(i)%write (u); write (u, *)
	end do

	write (u, *)
	write (u, "(A)") "* Initialize FS table"
	write (u, *)

	call constraints%init (1)
	call constraints%set (1, constrain_n_tot (3))

	call fs_table%init (model, pl, constraints)
	call fs_table%write (u)

	write (u, *)
	write (u, "(A)") "* Generate NLO corrections, unconstrained"
	write (u, *)

	call fs_table%radiate (constraints)
	call fs_table%write (u)
	call fs_table%final ()

	write (u, *)
	write (u, "(A)") "* Generate NLO corrections, &
	&complete but mass-constrained"
	write (u, *)

	sqrts = 50

	call constraints%init (2)
	call constraints%set (1, constrain_n_tot (3))
	call constraints%set (2, constrain_mass_sum (sqrts))

	call fs_table%init (model, pl, constraints)
	call fs_table%radiate (constraints)
	call fs_table%write (u)
	call fs_table%final ()

	write (u, *)
	write (u, "(A)") "* Generate NLO corrections, restricted"
	write (u, *)

	call pl_match%init ([1, -1, 21])

	call constraints%init (2)
	call constraints%set (1, constrain_n_tot (3))
	call constraints%set (2, constrain_insert (pl_match))

	call fs_table%init (model, pl, constraints)
	call fs_table%radiate (constraints)
	call fs_table%write (u)
	call fs_table%final ()

	write (u, *)
	write (u, "(A)") "* Generate NNLO corrections, restricted, with one loop"
	write (u, *)

	call pl_match%init ([1, -1, 21])

	call constraints%init (3)
	call constraints%set (1, constrain_n_tot (4))
	call constraints%set (2, constrain_n_loop (1))
	call constraints%set (3, constrain_insert (pl_match))

	call fs_table%init (model, pl, constraints)
	call fs_table%enable_loops ()
	call fs_table%radiate (constraints)
	call fs_table%write (u)
	call fs_table%final ()

	write (u, *)
	write (u, "(A)") "* Generate NNLO corrections, restricted, with loops"
	write (u, *)

	call constraints%init (2)
	call constraints%set (1, constrain_n_tot (4))
	call constraints%set (2, constrain_insert (pl_match))

	call fs_table%init (model, pl, constraints)
	call fs_table%enable_loops ()
	call fs_table%radiate (constraints)
	call fs_table%write (u)
	call fs_table%final ()

	write (u, *)
	write (u, "(A)") "* Generate NNLO corrections, restricted, to Z Z H, &
	&no loops"
	write (u, *)

	allocate (pl_zzh (1))
	call pl_zzh(1)%init (3)
	call pl_zzh(1)%set (1, 23)
	call pl_zzh(1)%set (2, 23)
	call pl_zzh(1)%set (3, 25)

	call constraints%init (3)
	call constraints%set (1, constrain_n_tot (5))
	call constraints%set (2, constrain_mass_sum (500._default))
	call constraints%set (3, constrain_require (pl_zzh(1)))

	call fs_table%init (model, pl_zzh, constraints)
	call fs_table%radiate (constraints)
	call fs_table%write (u)
	call fs_table%final ()

	call cleanup_model (model)
	deallocate (model)

	write (u, *)
	write (u, "(A)") "* Test output end: auto_components_2"

	end subroutine auto_components_2

	@ %def auto_components_2
	@
	\subsubsection{Generate radiation from initial and final state}
	Given a process, add radiation (NLO and NNLO). We provide a list
	of particles that is allowed to occur in the generated final states.
	<<Auto components: execute tests>>=
	call test (auto_components_3, "auto_components_3", &
	"generate NLO corrections, in and out", &
	u, results)
	<<Auto components: test declarations>>=
	public :: auto_components_3
	<<Auto components: tests>>=
	subroutine auto_components_3 (u)
	integer, intent(in) :: u
	class(model_data_t), pointer :: model
	type(pdg_list_t), dimension(:), allocatable :: pl_in, pl_out
	type(pdg_list_t) :: pl_match, pl_beam
	type(if_table_t) :: if_table
	type(split_constraints_t) :: constraints
	real(default) :: sqrts
	integer :: i

	write (u, "(A)") "* Test output: auto_components_3"
	write (u, "(A)") "* Purpose: generate radiation (NLO)"
	write (u, *)

	write (u, "(A)") "* Read Standard Model"

	model => null ()
	call prepare_model (model, var_str ("SM"))

	write (u, *)
	write (u, "(A)") "* LO initial state"
	write (u, *)

	allocate (pl_in (2))
	call pl_in(1)%init (2)
	call pl_in(1)%set (1, 1)
	call pl_in(1)%set (2, -1)
	call pl_in(2)%init (2)
	call pl_in(2)%set (1, -1)
	call pl_in(2)%set (2, 1)
	do i = 1, 2
	call pl_in(i)%write (u); write (u, *)
	end do

	write (u, *)
	write (u, "(A)") "* LO final state"
	write (u, *)

	allocate (pl_out (1))
	call pl_out(1)%init (1)
	call pl_out(1)%set (1, 23)
	call pl_out(1)%write (u); write (u, *)

	write (u, *)
	write (u, "(A)") "* Initialize FS table"
	write (u, *)

	call constraints%init (1)
	call constraints%set (1, constrain_n_tot (4))

	call if_table%init (model, pl_in, pl_out, constraints)
	call if_table%write (u)

	write (u, *)
	write (u, "(A)") "* Generate NLO corrections, unconstrained"
	write (u, *)

	call if_table%radiate (constraints)
	call if_table%write (u)
	call if_table%final ()

	write (u, *)
	write (u, "(A)") "* Generate NLO corrections, &
	&complete but mass-constrained"
	write (u, *)

	sqrts = 100
	call constraints%init (2)
	call constraints%set (1, constrain_n_tot (4))
	call constraints%set (2, constrain_mass_sum (sqrts))

	call if_table%init (model, pl_in, pl_out, constraints)
	call if_table%radiate (constraints)
	call if_table%write (u)
	call if_table%final ()

	write (u, *)
	write (u, "(A)") "* Generate NLO corrections, &
	&mass-constrained, restricted beams"
	write (u, *)

	call pl_beam%init (3)
	call pl_beam%set (1, 1)
	call pl_beam%set (2, -1)
	call pl_beam%set (3, 21)

	call constraints%init (3)
	call constraints%set (1, constrain_n_tot (4))
	call constraints%set (2, constrain_in_state (pl_beam))
	call constraints%set (3, constrain_mass_sum (sqrts))

	call if_table%init (model, pl_in, pl_out, constraints)
	call if_table%radiate (constraints)
	call if_table%write (u)
	call if_table%final ()

	write (u, *)
	write (u, "(A)") "* Generate NLO corrections, restricted"
	write (u, *)

	call pl_match%init ([1, -1, 21])

	call constraints%init (4)
	call constraints%set (1, constrain_n_tot (4))
	call constraints%set (2, constrain_in_state (pl_beam))
	call constraints%set (3, constrain_mass_sum (sqrts))
	call constraints%set (4, constrain_insert (pl_match))

	call if_table%init (model, pl_in, pl_out, constraints)
	call if_table%radiate (constraints)
	call if_table%write (u)
	call if_table%final ()

	write (u, *)
	write (u, "(A)") "* Generate NNLO corrections, restricted, Z preserved, &
	&with loops"
	write (u, *)

	call constraints%init (5)
	call constraints%set (1, constrain_n_tot (5))
	call constraints%set (2, constrain_in_state (pl_beam))
	call constraints%set (3, constrain_mass_sum (sqrts))
	call constraints%set (4, constrain_insert (pl_match))
	call constraints%set (5, constrain_require (pl_out(1)))

	call if_table%init (model, pl_in, pl_out, constraints)
	call if_table%enable_loops ()
	call if_table%radiate (constraints)
	call if_table%write (u)
	call if_table%final ()

	call cleanup_model (model)
	deallocate (model)

	write (u, *)
	write (u, "(A)") "* Test output end: auto_components_3"

	end subroutine auto_components_3

	@ %def auto_components_3
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Creating the real flavor structure}
	<<[[radiation_generator.f90]]>>=
	<<File header>>

	module radiation_generator

	<<Use kinds>>
	<<Use strings>>
	use sorting, only: sort_abs
	use pdg_arrays
	use model_data
	use auto_components

	implicit none
	private

	<<Radiation generator: public>>

	<<Radiation generator: types>>

	interface
	<<Radiation generator: sub interfaces>>
	end interface

	end module radiation_generator
	@ %def radiation_generator
	@
	<<[[radiation_generator_sub.f90]]>>=
	<<File header>>

	submodule (radiation_generator) radiation_generator_s

	use io_units
	use diagnostics
	use physics_defs, only: PHOTON, GLUON
	use string_utils, only: split_string, string_contains_word
	use flavors

	implicit none

	contains

	<<Radiation generator: procedures>>

	end submodule radiation_generator_s

	@ %def radiation_generator_s
	@
	<<Radiation generator: types>>=
	type :: pdg_sorter_t
	integer :: pdg
	logical :: checked = .false.
	integer :: associated_born = 0
	end type pdg_sorter_t

	@ %def pdg_sorter
	@
	<<Radiation generator: types>>=
	type :: pdg_states_t
	type(pdg_array_t), dimension(:), allocatable :: pdg
	type(pdg_states_t), pointer :: next
	integer :: n_particles
	contains
	<<Radiation generator: pdg states: TBP>>
	end type pdg_states_t

	@ %def pdg_states_t
	<<Radiation generator: pdg states: TBP>>=
	procedure :: init => pdg_states_init
	<<Radiation generator: sub interfaces>>=
	module subroutine pdg_states_init (states)
	class(pdg_states_t), intent(inout) :: states
	end subroutine pdg_states_init
	<<Radiation generator: procedures>>=
	module subroutine pdg_states_init (states)
	class(pdg_states_t), intent(inout) :: states
	nullify (states%next)
	end subroutine pdg_states_init

	@ %def pdg_states_init
	@
	<<Radiation generator: pdg states: TBP>>=
	procedure :: add => pdg_states_add
	<<Radiation generator: sub interfaces>>=
	module subroutine pdg_states_add (states, pdg)
	class(pdg_states_t), intent(inout), target :: states
	type(pdg_array_t), dimension(:), intent(in) :: pdg
	end subroutine pdg_states_add
	<<Radiation generator: procedures>>=
	module subroutine pdg_states_add (states, pdg)
	class(pdg_states_t), intent(inout), target :: states
	type(pdg_array_t), dimension(:), intent(in) :: pdg
	type(pdg_states_t), pointer :: current_state
	select type (states)
	type is (pdg_states_t)
	current_state => states
	do
	if (associated (current_state%next)) then
	current_state => current_state%next
	else
	allocate (current_state%next)
	nullify(current_state%next%next)
	current_state%pdg = pdg
	exit
	end if
	end do
	end select
	end subroutine pdg_states_add

	@ %def pdg_states_add
	@
	<<Radiation generator: pdg states: TBP>>=
	procedure :: get_n_states => pdg_states_get_n_states
	<<Radiation generator: sub interfaces>>=
	module function pdg_states_get_n_states (states) result (n)
	class(pdg_states_t), intent(in), target :: states
	integer :: n
	end function pdg_states_get_n_states
	<<Radiation generator: procedures>>=
	module function pdg_states_get_n_states (states) result (n)
	class(pdg_states_t), intent(in), target :: states
	integer :: n
	type(pdg_states_t), pointer :: current_state
	n = 0
	select type(states)
	type is (pdg_states_t)
	current_state => states
	do
	if (associated (current_state%next)) then
	n = n+1
	current_state => current_state%next
	else
	exit
	end if
	end do
	end select
	end function pdg_states_get_n_states

	@ %def pdg_states_get_n_states
	@
	<<Radiation generator: types>>=
	type :: prt_queue_t
	type(string_t), dimension(:), allocatable :: prt_string
	type(prt_queue_t), pointer :: next => null ()
	type(prt_queue_t), pointer :: previous => null ()
	type(prt_queue_t), pointer :: front => null ()
	type(prt_queue_t), pointer :: current_prt => null ()
	type(prt_queue_t), pointer :: back => null ()
	integer :: n_lists = 0
	contains
	<<Radiation generator: prt queue: TBP>>
	end type prt_queue_t

	@ %def prt_queue_t
	@
	<<Radiation generator: prt queue: TBP>>=
	procedure :: null => prt_queue_null
	<<Radiation generator: sub interfaces>>=
	module subroutine prt_queue_null (queue)
	class(prt_queue_t), intent(out) :: queue
	end subroutine prt_queue_null
	<<Radiation generator: procedures>>=
	module subroutine prt_queue_null (queue)
	class(prt_queue_t), intent(out) :: queue
	queue%next => null ()
	queue%previous => null ()
	queue%front => null ()
	queue%current_prt => null ()
	queue%back => null ()
	queue%n_lists = 0
	if (allocated (queue%prt_string)) deallocate (queue%prt_string)
	end subroutine prt_queue_null

	@ %def prt_queue_null
	@
	<<Radiation generator: prt queue: TBP>>=
	procedure :: append => prt_queue_append
	<<Radiation generator: sub interfaces>>=
	module subroutine prt_queue_append (queue, prt_string)
	class(prt_queue_t), intent(inout) :: queue
	type(string_t), intent(in), dimension(:) :: prt_string
	end subroutine prt_queue_append
	<<Radiation generator: procedures>>=
	module subroutine prt_queue_append (queue, prt_string)
	class(prt_queue_t), intent(inout) :: queue
	type(string_t), intent(in), dimension(:) :: prt_string
	type(prt_queue_t), pointer :: new_element => null ()
	type(prt_queue_t), pointer :: current_back => null ()
	allocate (new_element)
	allocate (new_element%prt_string(size (prt_string)))
	new_element%prt_string = prt_string
	if (associated (queue%back)) then
	current_back => queue%back
	current_back%next => new_element
	new_element%previous => current_back
	queue%back => new_element
	else
	!!! Initial entry
	queue%front => new_element
	queue%back => queue%front
	queue%current_prt => queue%front
	end if
	queue%n_lists = queue%n_lists + 1
	end subroutine prt_queue_append

	@ %def prt_queue_append
	@
	<<Radiation generator: prt queue: TBP>>=
	procedure :: get => prt_queue_get
	<<Radiation generator: sub interfaces>>=
	module subroutine prt_queue_get (queue, prt_string)
	class(prt_queue_t), intent(inout) :: queue
	type(string_t), dimension(:), allocatable, intent(out) :: prt_string
	end subroutine prt_queue_get
	<<Radiation generator: procedures>>=
	module subroutine prt_queue_get (queue, prt_string)
	class(prt_queue_t), intent(inout) :: queue
	type(string_t), dimension(:), allocatable, intent(out) :: prt_string
	if (associated (queue%current_prt)) then
	prt_string = queue%current_prt%prt_string
	if (associated (queue%current_prt%next)) &
	queue%current_prt => queue%current_prt%next
	else
	prt_string = " "
	end if
	end subroutine prt_queue_get

	@ %def prt_queue_get
	@ As above.
	<<Radiation generator: prt queue: TBP>>=
	procedure :: get_last => prt_queue_get_last
	<<Radiation generator: sub interfaces>>=
	module subroutine prt_queue_get_last (queue, prt_string)
	class(prt_queue_t), intent(in) :: queue
	type(string_t), dimension(:), allocatable, intent(out) :: prt_string
	end subroutine prt_queue_get_last
	<<Radiation generator: procedures>>=
	module subroutine prt_queue_get_last (queue, prt_string)
	class(prt_queue_t), intent(in) :: queue
	type(string_t), dimension(:), allocatable, intent(out) :: prt_string
	if (associated (queue%back)) then
	allocate (prt_string(size (queue%back%prt_string)))
	prt_string = queue%back%prt_string
	else
	prt_string = " "
	end if
	end subroutine prt_queue_get_last

	@ %def prt_queue_get_last
	@
	<<Radiation generator: prt queue: TBP>>=
	procedure :: reset => prt_queue_reset
	<<Radiation generator: sub interfaces>>=
	module subroutine prt_queue_reset (queue)
	class(prt_queue_t), intent(inout) :: queue
	end subroutine prt_queue_reset
	<<Radiation generator: procedures>>=
	module subroutine prt_queue_reset (queue)
	class(prt_queue_t), intent(inout) :: queue
	queue%current_prt => queue%front
	end subroutine prt_queue_reset

	@ %def prt_queue_reset
	@
	<<Radiation generator: prt queue: TBP>>=
	procedure :: check_for_same_prt_strings => prt_queue_check_for_same_prt_strings
	<<Radiation generator: sub interfaces>>=
	module function prt_queue_check_for_same_prt_strings (queue) result (val)
	class(prt_queue_t), intent(inout) :: queue
	logical :: val
	end function prt_queue_check_for_same_prt_strings
	<<Radiation generator: procedures>>=
	module function prt_queue_check_for_same_prt_strings (queue) result (val)
	class(prt_queue_t), intent(inout) :: queue
	logical :: val
	type(string_t), dimension(:), allocatable :: prt_string
	integer, dimension(:,:), allocatable :: i_particle
	integer :: n_d, n_dbar, n_u, n_ubar, n_s, n_sbar, n_gl, n_e, n_ep, n_mu, n_mup, n_A
	integer :: i, j
	call queue%reset ()
	allocate (i_particle (queue%n_lists, 12))
	do i = 1, queue%n_lists
	call queue%get (prt_string)
	n_d = count_particle (prt_string, 1)
	n_dbar = count_particle (prt_string, -1)
	n_u = count_particle (prt_string, 2)
	n_ubar = count_particle (prt_string, -2)
	n_s = count_particle (prt_string, 3)
	n_sbar = count_particle (prt_string, -3)
	n_gl = count_particle (prt_string, 21)
	n_e = count_particle (prt_string, 11)
	n_ep = count_particle (prt_string, -11)
	n_mu = count_particle (prt_string, 13)
	n_mup = count_particle (prt_string, -13)
	n_A = count_particle (prt_string, 22)
	i_particle (i, 1) = n_d
	i_particle (i, 2) = n_dbar
	i_particle (i, 3) = n_u
	i_particle (i, 4) = n_ubar
	i_particle (i, 5) = n_s
	i_particle (i, 6) = n_sbar
	i_particle (i, 7) = n_gl
	i_particle (i, 8) = n_e
	i_particle (i, 9) = n_ep
	i_particle (i, 10) = n_mu
	i_particle (i, 11) = n_mup
	i_particle (i, 12) = n_A
	end do
	val = .false.
	do i = 1, queue%n_lists
	do j = 1, queue%n_lists
	if (i == j) cycle
	val = val .or. all (i_particle (i,:) == i_particle(j,:))
	end do
	end do
	contains
	function count_particle (prt_string, pdg) result (n)
	type(string_t), dimension(:), intent(in) :: prt_string
	integer, intent(in) :: pdg
	integer :: n
	integer :: i
	type(string_t) :: prt_ref
	n = 0
	select case (pdg)
	case (1)
	prt_ref = "d"
	case (-1)
	prt_ref = "dbar"
	case (2)
	prt_ref = "u"
	case (-2)
	prt_ref = "ubar"
	case (3)
	prt_ref = "s"
	case (-3)
	prt_ref = "sbar"
	case (21)
	prt_ref = "gl"
	case (11)
	prt_ref = "e-"
	case (-11)
	prt_ref = "e+"
	case (13)
	prt_ref = "mu-"
	case (-13)
	prt_ref = "mu+"
	case (22)
	prt_ref = "A"
	end select
	do i = 1, size (prt_string)
	if (prt_string(i) == prt_ref) n = n+1
	end do
	end function count_particle

	end function prt_queue_check_for_same_prt_strings

	@ %def prt_queue_check_for_same_prt_strings
	@
	<<Radiation generator: prt queue: TBP>>=
	procedure :: contains => prt_queue_contains
	<<Radiation generator: sub interfaces>>=
	module function prt_queue_contains (queue, prt_string) result (val)
	class(prt_queue_t), intent(in) :: queue
	type(string_t), intent(in), dimension(:) :: prt_string
	logical :: val
	end function prt_queue_contains
	<<Radiation generator: procedures>>=
	module function prt_queue_contains (queue, prt_string) result (val)
	class(prt_queue_t), intent(in) :: queue
	type(string_t), intent(in), dimension(:) :: prt_string
	logical :: val
	type(prt_queue_t), pointer :: current => null()
	if (associated (queue%front)) then
	current => queue%front
	else
	call msg_fatal ("Trying to access empty particle queue")
	end if
	val = .false.
	do
	if (size (current%prt_string) == size (prt_string)) then
	if (all (current%prt_string == prt_string)) then
	val = .true.
	exit
	end if
	end if
	if (associated (current%next)) then
	current => current%next
	else
	exit
	end if
	end do
	end function prt_queue_contains

	@ %def prt_string_list_contains
	@
	<<Radiation generator: prt queue: TBP>>=
	procedure :: write => prt_queue_write
	<<Radiation generator: sub interfaces>>=
	module subroutine prt_queue_write (queue, unit)
	class(prt_queue_t), intent(in) :: queue
	integer, optional :: unit
	end subroutine prt_queue_write
	<<Radiation generator: procedures>>=
	module subroutine prt_queue_write (queue, unit)
	class(prt_queue_t), intent(in) :: queue
	integer, optional :: unit
	type(prt_queue_t), pointer :: current => null ()
	integer :: i, j, u
	u = given_output_unit (unit)
	if (associated (queue%front)) then
	current => queue%front
	else
	write (u, "(A)") "[Particle queue is empty]"
	return
	end if
	j = 1
	do
	write (u, "(I2,A,1X)", advance = 'no') j , ":"
	do i = 1, size (current%prt_string)
	write (u, "(A,1X)", advance = 'no') char (current%prt_string(i))
	end do
	write (u, "(A)")
	if (associated (current%next)) then
	current => current%next
	j = j+1
	else
	exit
	end if
	end do
	end subroutine prt_queue_write

	@ %def prt_queue_write
	@
	<<Radiation generator: procedures>>=
	subroutine sort_prt (prt, model)
	type(string_t), dimension(:), intent(inout) :: prt
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(:), allocatable :: pdg
	type(flavor_t) :: flv
	integer :: i
	call create_pdg_array (prt, model, pdg)
	call sort_pdg (pdg)
	do i = 1, size (pdg)
	call flv%init (pdg(i)%get(), model)
	prt(i) = flv%get_name ()
	end do
	end subroutine sort_prt

	subroutine sort_pdg (pdg)
	type(pdg_array_t), dimension(:), intent(inout) :: pdg
	integer, dimension(:), allocatable :: i_pdg
	integer :: i
	allocate (i_pdg (size (pdg)))
	do i = 1, size (pdg)
	i_pdg(i) = pdg(i)%get ()
	end do
	i_pdg = sort_abs (i_pdg)
	do i = 1, size (pdg)
	call pdg(i)%set (1, i_pdg(i))
	end do
	end subroutine sort_pdg

	subroutine create_pdg_array (prt, model, pdg)
	type (string_t), dimension(:), intent(in) :: prt
	class (model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(:), allocatable, intent(out) :: pdg
	type(flavor_t) :: flv
	integer :: i
	allocate (pdg (size (prt)))
	do i = 1, size (prt)
	call flv%init (prt(i), model)
	pdg(i) = flv%get_pdg ()
	end do
	end subroutine create_pdg_array

	@ %def sort_prt sort_pdg create_pdg_array
	@ This is used in unit tests:
	<<Radiation generator: test auxiliary>>=
	subroutine write_pdg_array (pdg, u)
	use pdg_arrays
	type(pdg_array_t), dimension(:), intent(in) :: pdg
	integer, intent(in) :: u
	integer :: i
	do i = 1, size (pdg)
	call pdg(i)%write (u)
	end do
	write (u, "(A)")
	end subroutine write_pdg_array

	subroutine write_particle_string (prt, u)
	<<Use strings>>
	type(string_t), dimension(:), intent(in) :: prt
	integer, intent(in) :: u
	integer :: i
	do i = 1, size (prt)
	write (u, "(A,1X)", advance = "no") char (prt(i))
	end do
	write (u, "(A)")
	end subroutine write_particle_string

	@ %def write_pdg_array write_particle_string
	<<Radiation generator: types>>=
	type :: reshuffle_list_t
	integer, dimension(:), allocatable :: ii
	type(reshuffle_list_t), pointer :: next => null ()
	contains
	<<Radiation generator: reshuffle list: TBP>>
	end type reshuffle_list_t

	@ %def reshuffle_list_t
	@
	<<Radiation generator: reshuffle list: TBP>>=
	procedure :: write => reshuffle_list_write
	<<Radiation generator: sub interfaces>>=
	module subroutine reshuffle_list_write (rlist)
	class(reshuffle_list_t), intent(in) :: rlist
	end subroutine reshuffle_list_write
	<<Radiation generator: procedures>>=
	module subroutine reshuffle_list_write (rlist)
	class(reshuffle_list_t), intent(in) :: rlist
	type(reshuffle_list_t), pointer :: current => null ()
	integer :: i
	print *, 'Content of reshuffling list: '
	if (associated (rlist%next)) then
	current => rlist%next
	i = 1
	do
	print *, 'i: ', i, 'list: ', current%ii
	i = i + 1
	if (associated (current%next)) then
	current => current%next
	else
	exit
	end if
	end do
	else
	print *, '[EMPTY]'
	end if
	end subroutine reshuffle_list_write

	@ %def reshuffle_list_write
	@
	<<Radiation generator: reshuffle list: TBP>>=
	procedure :: append => reshuffle_list_append
	<<Radiation generator: sub interfaces>>=
	module subroutine reshuffle_list_append (rlist, ii)
	class(reshuffle_list_t), intent(inout) :: rlist
	integer, dimension(:), allocatable, intent(in) :: ii
	end subroutine reshuffle_list_append
	<<Radiation generator: procedures>>=
	module subroutine reshuffle_list_append (rlist, ii)
	class(reshuffle_list_t), intent(inout) :: rlist
	integer, dimension(:), allocatable, intent(in) :: ii
	type(reshuffle_list_t), pointer :: current
	if (associated (rlist%next)) then
	current => rlist%next
	do
	if (associated (current%next)) then
	current => current%next
	else
	allocate (current%next)
	allocate (current%next%ii (size (ii)))
	current%next%ii = ii
	exit
	end if
	end do
	else
	allocate (rlist%next)
	allocate (rlist%next%ii (size (ii)))
	rlist%next%ii = ii
	end if
	end subroutine reshuffle_list_append

	@ %def reshuffle_list_append
	@
	<<Radiation generator: reshuffle list: TBP>>=
	procedure :: is_empty => reshuffle_list_is_empty
	<<Radiation generator: sub interfaces>>=
	elemental module function reshuffle_list_is_empty (rlist) result (is_empty)
	logical :: is_empty
	class(reshuffle_list_t), intent(in) :: rlist
	end function reshuffle_list_is_empty
	<<Radiation generator: procedures>>=
	elemental module function reshuffle_list_is_empty (rlist) result (is_empty)
	logical :: is_empty
	class(reshuffle_list_t), intent(in) :: rlist
	is_empty = .not. associated (rlist%next)
	end function reshuffle_list_is_empty

	@ %def reshuffle_list_is_empty
	@
	<<Radiation generator: reshuffle list: TBP>>=
	procedure :: get => reshuffle_list_get
	<<Radiation generator: sub interfaces>>=
	module function reshuffle_list_get (rlist, index) result (ii)
	integer, dimension(:), allocatable :: ii
	class(reshuffle_list_t), intent(inout) :: rlist
	integer, intent(in) :: index
	end function reshuffle_list_get
	<<Radiation generator: procedures>>=
	module function reshuffle_list_get (rlist, index) result (ii)
	integer, dimension(:), allocatable :: ii
	class(reshuffle_list_t), intent(inout) :: rlist
	integer, intent(in) :: index
	type(reshuffle_list_t), pointer :: current => null ()
	integer :: i
	current => rlist%next
	do i = 1, index - 1
	if (associated (current%next)) then
	current => current%next
	else
	call msg_fatal ("Index exceeds size of reshuffling list")
	end if
	end do
	allocate (ii (size (current%ii)))
	ii = current%ii
	end function reshuffle_list_get

	@ %def reshuffle_list_get
	@ We need to reset the [[reshuffle_list]] in order to deal with
	subsequent usages of the [[radiation_generator]]. Below is obviously
	the lazy and dirty solution. Otherwise, we would have to equip this
	auxiliary type with additional information about [[last]] and [[previous]]
	pointers. Considering that at most $n_{\rm{legs}}$ integers are saved
	in the lists, and that the subroutine is only called during the
	initialization phase (more precisely: at the moment only in the
	[[radiation_generator]] unit tests), I think this quick fix is justified.
	<<Radiation generator: reshuffle list: TBP>>=
	procedure :: reset => reshuffle_list_reset
	<<Radiation generator: sub interfaces>>=
	module subroutine reshuffle_list_reset (rlist)
	class(reshuffle_list_t), intent(inout) :: rlist
	end subroutine reshuffle_list_reset
	<<Radiation generator: procedures>>=
	module subroutine reshuffle_list_reset (rlist)
	class(reshuffle_list_t), intent(inout) :: rlist
	rlist%next => null ()
	end subroutine reshuffle_list_reset

	@ %def reshuffle_list_reset
	@
	<<Radiation generator: public>>=
	public :: radiation_generator_t
	<<Radiation generator: types>>=
	type :: radiation_generator_t
	logical :: qcd_enabled = .false.
	logical :: qed_enabled = .false.
	logical :: is_gluon = .false.
	logical :: fs_gluon = .false.
	logical :: is_photon = .false.
	logical :: fs_photon = .false.
	logical :: only_final_state = .true.
	type(pdg_list_t) :: pl_in, pl_out
	type(pdg_list_t) :: pl_excluded_gauge_splittings
	type(split_constraints_t) :: constraints
	integer :: n_tot
	integer :: n_in, n_out
	integer :: n_loops
	integer :: n_light_quarks
	real(default) :: mass_sum
	type(prt_queue_t) :: prt_queue
	type(pdg_states_t) :: pdg_raw
	type(pdg_array_t), dimension(:), allocatable :: pdg_in_born, pdg_out_born
	type(if_table_t) :: if_table
	type(reshuffle_list_t) :: reshuffle_list
	contains
	<<Radiation generator: radiation generator: TBP>>
	end type radiation_generator_t

	@ %def radiation_generator_t
	@ These are infrastructur types needed in some of the routines.
	<<Radiation generator: types>>=
	type :: prt_array_t
	type(string_t), dimension(:), allocatable :: prt
	end type prt_array_t

	@ %def prt_array_t
	@
	<<Radiation generator: types>>=
	type :: prt_table_t
	type(string_t), dimension(:), allocatable :: prt
	end type prt_table_t

	@ %def prt_table_t
	@
	<<Radiation generator: radiation generator: TBP>>=
	generic :: init => init_pdg_list, init_pdg_array
	procedure :: init_pdg_list => radiation_generator_init_pdg_list
	procedure :: init_pdg_array => radiation_generator_init_pdg_array
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_init_pdg_list &
	(generator, pl_in, pl_out, pl_excluded_gauge_splittings, qcd, qed)
	class(radiation_generator_t), intent(inout) :: generator
	type(pdg_list_t), intent(in) :: pl_in, pl_out
	type(pdg_list_t), intent(in) :: pl_excluded_gauge_splittings
	logical, intent(in), optional :: qcd, qed
	end subroutine radiation_generator_init_pdg_list
	module subroutine radiation_generator_init_pdg_array &
	(generator, pdg_in, pdg_out, pdg_excluded_gauge_splittings, qcd, qed)
	class(radiation_generator_t), intent(inout) :: generator
	type(pdg_array_t), intent(in), dimension(:) :: pdg_in, pdg_out
	type(pdg_array_t), intent(in), dimension(:) :: pdg_excluded_gauge_splittings
	logical, intent(in), optional :: qcd, qed
	end subroutine radiation_generator_init_pdg_array
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_init_pdg_list &
	(generator, pl_in, pl_out, pl_excluded_gauge_splittings, qcd, qed)
	class(radiation_generator_t), intent(inout) :: generator
	type(pdg_list_t), intent(in) :: pl_in, pl_out
	type(pdg_list_t), intent(in) :: pl_excluded_gauge_splittings
	logical, intent(in), optional :: qcd, qed
	if (present (qcd)) generator%qcd_enabled = qcd
	if (present (qed)) generator%qed_enabled = qed
	generator%pl_in = pl_in
	generator%pl_out = pl_out
	generator%pl_excluded_gauge_splittings = pl_excluded_gauge_splittings
	generator%is_gluon = pl_in%search_for_particle (GLUON)
	generator%fs_gluon = pl_out%search_for_particle (GLUON)
	generator%is_photon = pl_in%search_for_particle (PHOTON)
	generator%fs_photon = pl_out%search_for_particle (PHOTON)
	generator%mass_sum = 0._default
	call generator%pdg_raw%init ()
	end subroutine radiation_generator_init_pdg_list

	module subroutine radiation_generator_init_pdg_array &
	(generator, pdg_in, pdg_out, pdg_excluded_gauge_splittings, qcd, qed)
	class(radiation_generator_t), intent(inout) :: generator
	type(pdg_array_t), intent(in), dimension(:) :: pdg_in, pdg_out
	type(pdg_array_t), intent(in), dimension(:) :: pdg_excluded_gauge_splittings
	logical, intent(in), optional :: qcd, qed
	type(pdg_list_t) :: pl_in, pl_out
	type(pdg_list_t) :: pl_excluded_gauge_splittings
	integer :: i
	call pl_in%init(size (pdg_in))
	call pl_out%init(size (pdg_out))
	do i = 1, size (pdg_in)
	call pl_in%set (i, pdg_in(i))
	end do
	do i = 1, size (pdg_out)
	call pl_out%set (i, pdg_out(i))
	end do
	call pl_excluded_gauge_splittings%init(size (pdg_excluded_gauge_splittings))
	do i = 1, size (pdg_excluded_gauge_splittings)
	call pl_excluded_gauge_splittings%set &
	(i, pdg_excluded_gauge_splittings(i))
	end do
	call generator%init (pl_in, pl_out, pl_excluded_gauge_splittings, qcd, qed)
	end subroutine radiation_generator_init_pdg_array

	@ %def radiation_generator_init_pdg_list radiation_generator_init_pdg_array
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: set_initial_state_emissions => &
	radiation_generator_set_initial_state_emissions
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_set_initial_state_emissions (generator)
	class(radiation_generator_t), intent(inout) :: generator
	end subroutine radiation_generator_set_initial_state_emissions
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_set_initial_state_emissions (generator)
	class(radiation_generator_t), intent(inout) :: generator
	generator%only_final_state = .false.
	end subroutine radiation_generator_set_initial_state_emissions

	@ %def radiation_generator_set_initial_state_emissions
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: setup_if_table => radiation_generator_setup_if_table
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_setup_if_table (generator, model)
	class(radiation_generator_t), intent(inout) :: generator
	class(model_data_t), intent(in), target :: model
	end subroutine radiation_generator_setup_if_table
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_setup_if_table (generator, model)
	class(radiation_generator_t), intent(inout) :: generator
	class(model_data_t), intent(in), target :: model
	type(pdg_list_t), dimension(:), allocatable :: pl_in, pl_out

	allocate (pl_in(1), pl_out(1))

	pl_in(1) = generator%pl_in
	pl_out(1) = generator%pl_out

	call generator%if_table%init &
	(model, pl_in, pl_out, generator%constraints)
	end subroutine radiation_generator_setup_if_table

	@ %def radiation_generator_setup_if_table
	@
	<<Radiation generator: radiation generator: TBP>>=
	generic :: reset_particle_content => reset_particle_content_pdg_array, &
	reset_particle_content_pdg_list
	procedure :: reset_particle_content_pdg_list => &
	radiation_generator_reset_particle_content_pdg_list
	procedure :: reset_particle_content_pdg_array => &
	radiation_generator_reset_particle_content_pdg_array
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_reset_particle_content_pdg_list (generator, pl)
	class(radiation_generator_t), intent(inout) :: generator
	type(pdg_list_t), intent(in) :: pl
	end subroutine radiation_generator_reset_particle_content_pdg_list
	module subroutine radiation_generator_reset_particle_content_pdg_array (generator, pdg)
	class(radiation_generator_t), intent(inout) :: generator
	type(pdg_array_t), intent(in), dimension(:) :: pdg
	end subroutine radiation_generator_reset_particle_content_pdg_array
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_reset_particle_content_pdg_list (generator, pl)
	class(radiation_generator_t), intent(inout) :: generator
	type(pdg_list_t), intent(in) :: pl
	generator%pl_out = pl
	generator%fs_gluon = pl%search_for_particle (GLUON)
	generator%fs_photon = pl%search_for_particle (PHOTON)
	end subroutine radiation_generator_reset_particle_content_pdg_list

	module subroutine radiation_generator_reset_particle_content_pdg_array (generator, pdg)
	class(radiation_generator_t), intent(inout) :: generator
	type(pdg_array_t), intent(in), dimension(:) :: pdg
	type(pdg_list_t) :: pl
	integer :: i
	call pl%init (size (pdg))
	do i = 1, size (pdg)
	call pl%set (i, pdg(i))
	end do
	call generator%reset_particle_content (pl)
	end subroutine radiation_generator_reset_particle_content_pdg_array

	@ %def radiation_generator_reset_particle_content
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: reset_reshuffle_list=> radiation_generator_reset_reshuffle_list
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_reset_reshuffle_list (generator)
	class(radiation_generator_t), intent(inout) :: generator
	end subroutine radiation_generator_reset_reshuffle_list
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_reset_reshuffle_list (generator)
	class(radiation_generator_t), intent(inout) :: generator
	call generator%reshuffle_list%reset ()
	end subroutine radiation_generator_reset_reshuffle_list

	@ %def radiation_generator_reset_reshuffle_list
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: set_n => radiation_generator_set_n
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_set_n (generator, n_in, n_out, n_loops)
	class(radiation_generator_t), intent(inout) :: generator
	integer, intent(in) :: n_in, n_out, n_loops
	end subroutine radiation_generator_set_n
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_set_n (generator, n_in, n_out, n_loops)
	class(radiation_generator_t), intent(inout) :: generator
	integer, intent(in) :: n_in, n_out, n_loops
	generator%n_tot = n_in + n_out + 1
	generator%n_in = n_in
	generator%n_out = n_out
	generator%n_loops = n_loops
	end subroutine radiation_generator_set_n

	@ %def radiation_generator_set_n
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: set_constraints => radiation_generator_set_constraints
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_set_constraints &
	(generator, set_n_loop, set_mass_sum, &
	set_selected_particles, set_required_particles)
	class(radiation_generator_t), intent(inout), target :: generator
	logical, intent(in) :: set_n_loop
	logical, intent(in) :: set_mass_sum
	logical, intent(in) :: set_selected_particles
	logical, intent(in) :: set_required_particles
	end subroutine radiation_generator_set_constraints
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_set_constraints &
	(generator, set_n_loop, set_mass_sum, &
	set_selected_particles, set_required_particles)
	class(radiation_generator_t), intent(inout), target :: generator
	logical, intent(in) :: set_n_loop
	logical, intent(in) :: set_mass_sum
	logical, intent(in) :: set_selected_particles
	logical, intent(in) :: set_required_particles
	logical :: set_no_photon_induced = .true.
	integer :: i, j, n, n_constraints
	type(pdg_list_t) :: pl_req, pl_insert
	type(pdg_list_t) :: pl_antiparticles
	type(pdg_array_t) :: pdg_gluon, pdg_photon
	type(pdg_array_t) :: pdg_add, pdg_tmp
	integer :: last_index
	integer :: n_new_particles, n_skip
	integer, dimension(:), allocatable :: i_skip
	integer :: n_nlo_correction_types

	n_nlo_correction_types = count ([generator%qcd_enabled, generator%qed_enabled])
	if (generator%is_photon) set_no_photon_induced = .false.

	allocate (i_skip (generator%n_tot))
	i_skip = -1

	n_constraints = 2 + count([set_n_loop, set_mass_sum, &
	set_selected_particles, set_required_particles, set_no_photon_induced])
	associate (constraints => generator%constraints)
	n = 1
	call constraints%init (n_constraints)
	call constraints%set (n, constrain_n_tot (generator%n_tot))
	n = 2
	call constraints%set (n, constrain_couplings (generator%qcd_enabled, &
	generator%qed_enabled, n_nlo_correction_types))
	n = n + 1
	if (set_no_photon_induced) then
	call constraints%set (n, constrain_photon_induced_processes (generator%n_in))
	n = n + 1
	end if
	if (set_n_loop) then
	call constraints%set (n, constrain_n_loop(generator%n_loops))
	n = n + 1
	end if
	if (set_mass_sum) then
	call constraints%set (n, constrain_mass_sum(generator%mass_sum))
	n = n + 1
	end if
	if (set_required_particles) then
	if (generator%fs_gluon .or. generator%fs_photon) then
	do i = 1, generator%n_out
	pdg_tmp = generator%pl_out%get(i)
	if (pdg_tmp%search_for_particle (GLUON) &
	.or. pdg_tmp%search_for_particle (PHOTON)) then
	i_skip(i) = i
	end if
	end do

	n_skip = count (i_skip > 0)
	call pl_req%init (generator%n_out-n_skip)
	else
	call pl_req%init (generator%n_out)
	end if
	j = 1
	do i = 1, generator%n_out
	if (any (i == i_skip)) cycle
	call pl_req%set (j, generator%pl_out%get(i))
	j = j + 1
	end do
	call constraints%set (n, constrain_require (pl_req))
	n = n + 1
	end if
	if (set_selected_particles) then
	if (generator%only_final_state ) then
	call pl_insert%init (generator%n_out + n_nlo_correction_types)
	do i = 1, generator%n_out
	call pl_insert%set(i, generator%pl_out%get(i))
	end do
	last_index = generator%n_out + 1
	else
	call generator%pl_in%create_antiparticles (pl_antiparticles, n_new_particles)
	call pl_insert%init (generator%n_tot + n_new_particles &
	+ n_nlo_correction_types)
	do i = 1, generator%n_in
	call pl_insert%set(i, generator%pl_in%get(i))
	end do
	do i = 1, generator%n_out
	j = i + generator%n_in
	call pl_insert%set(j, generator%pl_out%get(i))
	end do
	do i = 1, n_new_particles
	j = i + generator%n_in + generator%n_out
	call pl_insert%set(j, pl_antiparticles%get(i))
	end do
	last_index = generator%n_tot + n_new_particles + 1
	end if
	pdg_gluon = GLUON; pdg_photon = PHOTON
	if (generator%qcd_enabled) then
	pdg_add = pdg_gluon
	call pl_insert%set (last_index, pdg_add)
	last_index = last_index + 1
	end if
	if (generator%qed_enabled) then
	pdg_add = pdg_photon
	call pl_insert%set (last_index, pdg_add)
	end if
	call constraints%set (n, constrain_splittings (pl_insert, &
	generator%pl_excluded_gauge_splittings))
	end if
	end associate
	end subroutine radiation_generator_set_constraints

	@ %def radiation_generator_set_constraints
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: find_splittings => radiation_generator_find_splittings
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_find_splittings (generator)
	class(radiation_generator_t), intent(inout) :: generator
	end subroutine radiation_generator_find_splittings
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_find_splittings (generator)
	class(radiation_generator_t), intent(inout) :: generator
	integer :: i
	type(pdg_array_t), dimension(:), allocatable :: pdg_in, pdg_out, pdg_tmp
	integer, dimension(:), allocatable :: reshuffle_list

	call generator%pl_in%create_pdg_array (pdg_in)
	call generator%pl_out%create_pdg_array (pdg_out)

	associate (if_table => generator%if_table)
	call if_table%radiate (generator%constraints, do_not_check_regular = .true.)

	do i = 1, if_table%get_length ()
	call if_table%get_pdg_out (i, pdg_tmp)
	if (size (pdg_tmp) == generator%n_tot) then
	call pdg_reshuffle (pdg_out, pdg_tmp, reshuffle_list)
	call generator%reshuffle_list%append (reshuffle_list)
	end if
	end do
	end associate

	contains

	subroutine pdg_reshuffle (pdg_born, pdg_real, list)
	type(pdg_array_t), intent(in), dimension(:) :: pdg_born, pdg_real
	integer, intent(out), dimension(:), allocatable :: list
	type(pdg_sorter_t), dimension(:), allocatable :: sort_born
	type(pdg_sorter_t), dimension(:), allocatable :: sort_real
	integer :: i_min, n_in, n_born, n_real
	integer :: ib, ir

	n_in = generator%n_in
	n_born = size (pdg_born)
	n_real = size (pdg_real)
	allocate (list (n_real - n_in))
	allocate (sort_born (n_born))
	allocate (sort_real (n_real - n_in))
	sort_born%pdg = pdg_born%get ()
	sort_real%pdg = pdg_real(n_in + 1 : n_real)%get()
	do ib = 1, n_born
	if (any (sort_born(ib)%pdg == sort_real%pdg)) &
	call associate_born_indices (sort_born(ib), sort_real, ib, n_real)
	end do
	i_min = maxval (sort_real%associated_born) + 1
	do ir = 1, n_real - n_in
	if (sort_real(ir)%associated_born == 0) then
	sort_real(ir)%associated_born = i_min
	i_min = i_min + 1
	end if
	end do
	list = sort_real%associated_born
	end subroutine pdg_reshuffle

	subroutine associate_born_indices (sort_born, sort_real, ib, n_real)
	type(pdg_sorter_t), intent(in) :: sort_born
	type(pdg_sorter_t), intent(inout), dimension(:) :: sort_real
	integer, intent(in) :: ib, n_real
	integer :: ir
	do ir = 1, n_real - generator%n_in
	if (sort_born%pdg == sort_real(ir)%pdg &
	.and..not. sort_real(ir)%checked) then
	sort_real(ir)%associated_born = ib
	sort_real(ir)%checked = .true.
	exit
	end if
	end do
	end subroutine associate_born_indices
	end subroutine radiation_generator_find_splittings

	@ %def radiation_generator_find_splittings
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: generate_real_particle_strings &
	=> radiation_generator_generate_real_particle_strings
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_generate_real_particle_strings &
	(generator, prt_tot_in, prt_tot_out)
	class(radiation_generator_t), intent(inout) :: generator
	type(string_t), intent(out), dimension(:), allocatable :: prt_tot_in, prt_tot_out
	end subroutine radiation_generator_generate_real_particle_strings
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_generate_real_particle_strings &
	(generator, prt_tot_in, prt_tot_out)
	class(radiation_generator_t), intent(inout) :: generator
	type(string_t), intent(out), dimension(:), allocatable :: prt_tot_in, prt_tot_out
	type(prt_array_t), dimension(:), allocatable :: prt_in, prt_out
	type(prt_array_t), dimension(:), allocatable :: prt_out0, prt_in0
	type(pdg_array_t), dimension(:), allocatable :: pdg_tmp, pdg_out, pdg_in
	type(pdg_list_t), dimension(:), allocatable :: pl_in, pl_out
	type(prt_array_t) :: prt_out0_tmp, prt_in0_tmp
	integer :: i, j
	integer, dimension(:), allocatable :: reshuffle_list_local
	type(reshuffle_list_t) :: reshuffle_list
	integer :: flv
	type(string_t), dimension(:), allocatable :: buf
	integer :: i_buf

	flv = 0
	allocate (prt_in0(0), prt_out0(0))
	associate (if_table => generator%if_table)
	do i = 1, if_table%get_length ()
	call if_table%get_pdg_out (i, pdg_tmp)
	if (size (pdg_tmp) == generator%n_tot) then
	call if_table%get_particle_string (i, &
	prt_in0_tmp%prt, prt_out0_tmp%prt)
	prt_in0 = [prt_in0, prt_in0_tmp]
	prt_out0 = [prt_out0, prt_out0_tmp]
	flv = flv + 1
	end if
	end do
	end associate

	allocate (prt_in(size (prt_in0)), prt_out(size (prt_out0)))
	do i = 1, flv
	allocate (prt_in(i)%prt (generator%n_in))
	allocate (prt_out(i)%prt (generator%n_tot - generator%n_in))
	end do
	allocate (prt_tot_in (generator%n_in))
	allocate (prt_tot_out (generator%n_tot - generator%n_in))
	allocate (buf (generator%n_tot))
	buf = ""

	do j = 1, flv
	do i = 1, generator%n_in
	prt_in(j)%prt(i) = prt_in0(j)%prt(i)
	call fill_buffer (buf(i), prt_in0(j)%prt(i))
	end do
	end do
	prt_tot_in = buf(1 : generator%n_in)

	do j = 1, flv
	allocate (reshuffle_list_local (size (generator%reshuffle_list%get(j))))
	reshuffle_list_local = generator%reshuffle_list%get(j)
	do i = 1, size (reshuffle_list_local)
	prt_out(j)%prt(reshuffle_list_local(i)) = prt_out0(j)%prt(i)
	i_buf = reshuffle_list_local(i) + generator%n_in
	call fill_buffer (buf(i_buf), &
	prt_out(j)%prt(reshuffle_list_local(i)))
	end do
	!!! Need to deallocate here because in the next iteration the reshuffling
	!!! list can have a different size
	deallocate (reshuffle_list_local)
	end do
	prt_tot_out = buf(generator%n_in + 1 : generator%n_tot)
	if (debug2_active (D_CORE)) then
	print *, 'Generated initial state: '
	do i = 1, size (prt_tot_in)
	print *, char (prt_tot_in(i))
	end do
	print *, 'Generated final state: '
	do i = 1, size (prt_tot_out)
	print *, char (prt_tot_out(i))
	end do
	end if


	contains

	subroutine fill_buffer (buffer, particle)
	type(string_t), intent(inout) :: buffer
	type(string_t), intent(in) :: particle
	logical :: particle_present
	if (len (buffer) > 0) then
	particle_present = check_for_substring (char(buffer), particle)
	if (.not. particle_present) buffer = buffer // ":" // particle
	else
	buffer = buffer // particle
	end if
	end subroutine fill_buffer

	function check_for_substring (buffer, substring) result (exist)
	character(len=*), intent(in) :: buffer
	type(string_t), intent(in) :: substring
	character(len=50) :: buffer_internal
	logical :: exist
	integer :: i_first, i_last
	exist = .false.
	i_first = 1; i_last = 1
	do
	if (buffer(i_last:i_last) == ":") then
	buffer_internal = buffer (i_first : i_last - 1)
	if (buffer_internal == char (substring)) then
	exist = .true.
	exit
	end if
	i_first = i_last + 1; i_last = i_first + 1
	if (i_last > len(buffer)) exit
	else if (i_last == len(buffer)) then
	buffer_internal = buffer (i_first : i_last)
	exist = buffer_internal == char (substring)
	exit
	else
	i_last = i_last + 1
	if (i_last > len(buffer)) exit
	end if
	end do
	end function check_for_substring
	end subroutine radiation_generator_generate_real_particle_strings

	@ %def radiation_generator_generate_real_particle_strings
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: contains_emissions => radiation_generator_contains_emissions
	<<Radiation generator: sub interfaces>>=
	module function radiation_generator_contains_emissions (generator) result (has_em)
	logical :: has_em
	class(radiation_generator_t), intent(in) :: generator
	end function radiation_generator_contains_emissions
	<<Radiation generator: procedures>>=
	module function radiation_generator_contains_emissions (generator) result (has_em)
	logical :: has_em
	class(radiation_generator_t), intent(in) :: generator
	has_em = .not. generator%reshuffle_list%is_empty ()
	end function radiation_generator_contains_emissions

	@ %def radiation_generator_contains_emissions
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: generate => radiation_generator_generate
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_generate (generator, prt_in, prt_out)
	class(radiation_generator_t), intent(inout) :: generator
	type(string_t), intent(out), dimension(:), allocatable :: prt_in, prt_out
	end subroutine radiation_generator_generate
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_generate (generator, prt_in, prt_out)
	class(radiation_generator_t), intent(inout) :: generator
	type(string_t), intent(out), dimension(:), allocatable :: prt_in, prt_out
	call generator%find_splittings ()
	call generator%generate_real_particle_strings (prt_in, prt_out)
	end subroutine radiation_generator_generate

	@ %def radiation_generator_generate
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: generate_multiple => radiation_generator_generate_multiple
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_generate_multiple &
	(generator, max_multiplicity, model)
	class(radiation_generator_t), intent(inout) :: generator
	integer, intent(in) :: max_multiplicity
	class(model_data_t), intent(in), target :: model
	end subroutine radiation_generator_generate_multiple
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_generate_multiple &
	(generator, max_multiplicity, model)
	class(radiation_generator_t), intent(inout) :: generator
	integer, intent(in) :: max_multiplicity
	class(model_data_t), intent(in), target :: model
	if (max_multiplicity <= generator%n_out) &
	call msg_fatal ("GKS states: Multiplicity is not large enough!")
	call generator%first_emission (model)
	call generator%reset_reshuffle_list ()
	if (max_multiplicity - generator%n_out > 1) &
	call generator%append_emissions (max_multiplicity, model)
	end subroutine radiation_generator_generate_multiple

	@ %def radiation_generator_generate_multiple
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: first_emission => radiation_generator_first_emission
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_first_emission (generator, model)
	class(radiation_generator_t), intent(inout) :: generator
	class(model_data_t), intent(in), target :: model
	end subroutine radiation_generator_first_emission
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_first_emission (generator, model)
	class(radiation_generator_t), intent(inout) :: generator
	class(model_data_t), intent(in), target :: model
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	call generator%setup_if_table (model)
	call generator%generate (prt_in, prt_out)
	call generator%prt_queue%null ()
	call generator%prt_queue%append (prt_out)
	end subroutine radiation_generator_first_emission

	@ %def radiation_generator_first_emission
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: append_emissions => radiation_generator_append_emissions
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_append_emissions &
	(generator, max_multiplicity, model)
	class(radiation_generator_t), intent(inout) :: generator
	integer, intent(in) :: max_multiplicity
	class(model_data_t), intent(in), target :: model
	end subroutine radiation_generator_append_emissions
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_append_emissions &
	(generator, max_multiplicity, model)
	class(radiation_generator_t), intent(inout) :: generator
	integer, intent(in) :: max_multiplicity
	class(model_data_t), intent(in), target :: model
	type(string_t), dimension(:), allocatable :: prt_fetched
	type(string_t), dimension(:), allocatable :: prt_in
	type(string_t), dimension(:), allocatable :: prt_out
	type(pdg_array_t), dimension(:), allocatable :: pdg_new_out
	integer :: current_multiplicity, i, j, n_longest_length
	type(prt_table_t), dimension(:), allocatable :: prt_table_out
	do
	call generator%prt_queue%get (prt_fetched)
	current_multiplicity = size (prt_fetched)
	if (current_multiplicity == max_multiplicity) exit
	call create_pdg_array (prt_fetched, model, &
	pdg_new_out)
	call generator%reset_particle_content (pdg_new_out)
	call generator%set_n (2, current_multiplicity, 0)
	call generator%set_constraints (.false., .false., .true., .true.)
	call generator%setup_if_table (model)
	call generator%generate (prt_in, prt_out)
	n_longest_length = get_length_of_longest_tuple (prt_out)
	call separate_particles (prt_out, prt_table_out)
	do i = 1, n_longest_length
	if (.not. any (prt_table_out(i)%prt == " ")) then
	call sort_prt (prt_table_out(i)%prt, model)
	if (.not. generator%prt_queue%contains (prt_table_out(i)%prt)) then
	call generator%prt_queue%append (prt_table_out(i)%prt)
	end if
	end if
	end do
	call generator%reset_reshuffle_list ()
	end do

	contains
	subroutine separate_particles (prt, prt_table)
	type(string_t), intent(in), dimension(:) :: prt
	type(string_t), dimension(:), allocatable :: prt_tmp
	type(prt_table_t), intent(out), dimension(:), allocatable :: prt_table
	integer :: i, j
	logical, dimension(:), allocatable :: tuples_occured
	allocate (prt_table (n_longest_length))
	do i = 1, n_longest_length
	allocate (prt_table(i)%prt (size (prt)))
	end do
	allocate (tuples_occured (size (prt)))
	do j = 1, size (prt)
	call split_string (prt(j), var_str (":"), prt_tmp)
	do i = 1, n_longest_length
	if (i <= size (prt_tmp)) then
	prt_table(i)%prt(j) = prt_tmp(i)
	else
	prt_table(i)%prt(j) = " "
	end if
	end do
	if (n_longest_length > 1) &
	tuples_occured(j) = prt_table(1)%prt(j) /= " " &
	.and. prt_table(2)%prt(j) /= " "
	end do
	if (any (tuples_occured)) then
	do j = 1, size (tuples_occured)
	if (.not. tuples_occured(j)) then
	do i = 2, n_longest_length
	prt_table(i)%prt(j) = prt_table(1)%prt(j)
	end do
	end if
	end do
	end if
	end subroutine separate_particles

	function get_length_of_longest_tuple (prt) result (longest_length)
	type(string_t), intent(in), dimension(:) :: prt
	integer :: longest_length, i
	type(prt_table_t), dimension(:), allocatable :: prt_table
	allocate (prt_table (size (prt)))
	longest_length = 0
	do i = 1, size (prt)
	call split_string (prt(i), var_str (":"), prt_table(i)%prt)
	if (size (prt_table(i)%prt) > longest_length) &
	longest_length = size (prt_table(i)%prt)
	end do
	end function get_length_of_longest_tuple
	end subroutine radiation_generator_append_emissions
	@ %def radiation_generator_append_emissions
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: reset_queue => radiation_generator_reset_queue
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_reset_queue (generator)
	class(radiation_generator_t), intent(inout) :: generator
	end subroutine radiation_generator_reset_queue
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_reset_queue (generator)
	class(radiation_generator_t), intent(inout) :: generator
	call generator%prt_queue%reset ()
	end subroutine radiation_generator_reset_queue

	@ %def radiation_generator_reset_queue
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: get_n_gks_states => radiation_generator_get_n_gks_states
	<<Radiation generator: sub interfaces>>=
	module function radiation_generator_get_n_gks_states (generator) result (n)
	class(radiation_generator_t), intent(in) :: generator
	integer :: n
	end function radiation_generator_get_n_gks_states
	<<Radiation generator: procedures>>=
	module function radiation_generator_get_n_gks_states (generator) result (n)
	class(radiation_generator_t), intent(in) :: generator
	integer :: n
	n = generator%prt_queue%n_lists
	end function radiation_generator_get_n_gks_states

	@ %def radiation_generator_get_n_fks_states
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: get_next_state => radiation_generator_get_next_state
	<<Radiation generator: sub interfaces>>=
	module function radiation_generator_get_next_state (generator) result (prt_string)
	class(radiation_generator_t), intent(inout) :: generator
	type(string_t), dimension(:), allocatable :: prt_string
	end function radiation_generator_get_next_state
	<<Radiation generator: procedures>>=
	module function radiation_generator_get_next_state (generator) result (prt_string)
	class(radiation_generator_t), intent(inout) :: generator
	type(string_t), dimension(:), allocatable :: prt_string
	call generator%prt_queue%get (prt_string)
	end function radiation_generator_get_next_state

	@ %def radiation_generator_get_next_state
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: get_emitter_indices => radiation_generator_get_emitter_indices
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_get_emitter_indices (generator, indices)
	class(radiation_generator_t), intent(in) :: generator
	integer, dimension(:), allocatable, intent(out) :: indices
	end subroutine radiation_generator_get_emitter_indices
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_get_emitter_indices (generator, indices)
	class(radiation_generator_t), intent(in) :: generator
	integer, dimension(:), allocatable, intent(out) :: indices
	type(pdg_array_t), dimension(:), allocatable :: pdg_in, pdg_out
	integer, dimension(:), allocatable :: flv_in, flv_out
	integer, dimension(:), allocatable :: emitters
	integer :: i, j
	integer :: n_in, n_out

	call generator%pl_in%create_pdg_array (pdg_in)
	call generator%pl_out%create_pdg_array (pdg_out)

	n_in = size (pdg_in); n_out = size (pdg_out)
	allocate (flv_in (n_in), flv_out (n_out))
	forall (i=1:n_in) flv_in(i) = pdg_in(i)%get()
	forall (i=1:n_out) flv_out(i) = pdg_out(i)%get()

	call generator%if_table%get_emitters (generator%constraints, emitters)
	allocate (indices (size (emitters)))

	j = 1
	do i = 1, n_in + n_out
	if (i <= n_in) then
	if (any (flv_in(i) == emitters)) then
	indices (j) = i
	j = j + 1
	end if
	else
	if (any (flv_out(i-n_in) == emitters)) then
	indices (j) = i
	j = j + 1
	end if
	end if
	end do
	end subroutine radiation_generator_get_emitter_indices

	@ %def radiation_generator_get_emitter_indices
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: get_raw_states => radiation_generator_get_raw_states
	<<Radiation generator: sub interfaces>>=
	module function radiation_generator_get_raw_states (generator) result (raw_states)
	class(radiation_generator_t), intent(in), target :: generator
	integer, dimension(:,:), allocatable :: raw_states
	end function radiation_generator_get_raw_states
	<<Radiation generator: procedures>>=
	module function radiation_generator_get_raw_states (generator) result (raw_states)
	class(radiation_generator_t), intent(in), target :: generator
	integer, dimension(:,:), allocatable :: raw_states
	type(pdg_states_t), pointer :: state
	integer :: n_states, n_particles
	integer :: i_state
	integer :: j
	state => generator%pdg_raw
	n_states = generator%pdg_raw%get_n_states ()
	n_particles = size (generator%pdg_raw%pdg)
	allocate (raw_states (n_particles, n_states))
	do i_state = 1, n_states
	do j = 1, n_particles
	raw_states (j, i_state) = state%pdg(j)%get ()
	end do
	state => state%next
	end do
	end function radiation_generator_get_raw_states

	@ %def radiation_generator_get_raw_states
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: save_born_raw => radiation_generator_save_born_raw
	<<Radiation generator: sub interfaces>>=
	module subroutine radiation_generator_save_born_raw (generator, pdg_in, pdg_out)
	class(radiation_generator_t), intent(inout) :: generator
	type(pdg_array_t), dimension(:), allocatable, intent(in) :: pdg_in, pdg_out
	end subroutine radiation_generator_save_born_raw
	<<Radiation generator: procedures>>=
	module subroutine radiation_generator_save_born_raw (generator, pdg_in, pdg_out)
	class(radiation_generator_t), intent(inout) :: generator
	type(pdg_array_t), dimension(:), allocatable, intent(in) :: pdg_in, pdg_out
	generator%pdg_in_born = pdg_in
	generator%pdg_out_born = pdg_out
	end subroutine radiation_generator_save_born_raw
	@ %def radiation_generator_save_born_raw
	@
	<<Radiation generator: radiation generator: TBP>>=
	procedure :: get_born_raw => radiation_generator_get_born_raw
	<<Radiation generator: sub interfaces>>=
	module function radiation_generator_get_born_raw (generator) result (flv_born)
	class(radiation_generator_t), intent(in) :: generator
	integer, dimension(:,:), allocatable :: flv_born
	end function radiation_generator_get_born_raw
	<<Radiation generator: procedures>>=
	module function radiation_generator_get_born_raw (generator) result (flv_born)
	class(radiation_generator_t), intent(in) :: generator
	integer, dimension(:,:), allocatable :: flv_born
	integer :: i_part, n_particles
	n_particles = size (generator%pdg_in_born) + size (generator%pdg_out_born)
	allocate (flv_born (n_particles, 1))
	flv_born(1,1) = generator%pdg_in_born(1)%get ()
	flv_born(2,1) = generator%pdg_in_born(2)%get ()
	do i_part = 3, n_particles
	flv_born(i_part, 1) = generator%pdg_out_born(i_part-2)%get ()
	end do
	end function radiation_generator_get_born_raw

	@ %def radiation_generator_get_born_raw
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[radiation_generator_ut.f90]]>>=
	<<File header>>

	module radiation_generator_ut
	use unit_tests
	use radiation_generator_uti

	<<Standard module head>>

	<<Radiation generator: public test>>

	contains

	<<Radiation generator: test driver>>

	end module radiation_generator_ut
	@ %def radiation_generator_ut
	@
	<<[[radiation_generator_uti.f90]]>>=
	<<File header>>

	module radiation_generator_uti

	<<Use strings>>
	use format_utils, only: write_separator
	use os_interface
	use pdg_arrays
	use models
	use kinds, only: default

	use radiation_generator

	<<Standard module head>>

	<<Radiation generator: test declarations>>

	contains

	<<Radiation generator: tests>>

	<<Radiation generator: test auxiliary>>

	end module radiation_generator_uti
	@ %def radiation_generator_ut
	@ API: driver for the unit tests below.
	<<Radiation generator: public test>>=
	public :: radiation_generator_test
	<<Radiation generator: test driver>>=
	subroutine radiation_generator_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	call test(radiation_generator_1, "radiation_generator_1", &
	"Test the generator of N+1-particle flavor structures in QCD", &
	u, results)
	call test(radiation_generator_2, "radiation_generator_2", &
	"Test multiple splittings in QCD", &
	u, results)
	call test(radiation_generator_3, "radiation_generator_3", &
	"Test the generator of N+1-particle flavor structures in QED", &
	u, results)
	call test(radiation_generator_4, "radiation_generator_4", &
	"Test multiple splittings in QED", &
	u, results)
	end subroutine radiation_generator_test

	@ %def radiation_generator_test
	@
	<<Radiation generator: test declarations>>=
	public :: radiation_generator_1
	<<Radiation generator: tests>>=
	subroutine radiation_generator_1 (u)
	integer, intent(in) :: u
	type(radiation_generator_t) :: generator
	type(pdg_array_t), dimension(:), allocatable :: pdg_in, pdg_out
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(model_t), pointer :: model => null ()

	write (u, "(A)") "* Test output: radiation_generator_1"
	write (u, "(A)") "* Purpose: Create N+1-particle flavor structures &
	&from predefined N-particle flavor structures"
	write (u, "(A)") "* One additional strong coupling, no additional electroweak coupling"
	write (u, "(A)")
	write (u, "(A)") "* Loading radiation model: SM.mdl"

	call syntax_model_file_init ()
	call os_data%init ()
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)
	write (u, "(A)") "* Success"

	allocate (pdg_in (2))
	pdg_in(1) = 11; pdg_in(2) = -11

	write (u, "(A)") "* Start checking processes"
	call write_separator (u)

	write (u, "(A)") "* Process 1: Top pair-production with additional gluon"
	allocate (pdg_out(3))
	pdg_out(1) = 6; pdg_out(2) = -6; pdg_out(3) = 21
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 2: Top pair-production with additional jet"
	allocate (pdg_out(3))
	pdg_out(1) = 6; pdg_out(2) = -6; pdg_out(3) = [-1,1,-2,2,-3,3,-4,4,-5,5,21]
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 3: Quark-antiquark production"
	allocate (pdg_out(2))
	pdg_out(1) = 2; pdg_out(2) = -2
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 4: Quark-antiquark production with additional gluon"
	allocate (pdg_out(3))
	pdg_out(1) = 2; pdg_out(2) = -2; pdg_out(3) = 21
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 5: Z + jets"
	allocate (pdg_out(3))
	pdg_out(1) = 2; pdg_out(2) = -2; pdg_out(3) = 23
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 6: Top Decay"
	allocate (pdg_out(4))
	pdg_out(1) = 24; pdg_out(2) = -24
	pdg_out(3) = 5; pdg_out(4) = -5
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 7: Production of four quarks"
	allocate (pdg_out(4))
	pdg_out(1) = 2; pdg_out(2) = -2;
	pdg_out(3) = 2; pdg_out(4) = -2
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out); deallocate (pdg_in)

	write (u, "(A)") "* Process 8: Drell-Yan lepto-production"
	allocate (pdg_in (2)); allocate (pdg_out (2))
	pdg_in(1) = 2; pdg_in(2) = -2
	pdg_out(1) = 11; pdg_out(2) = -11
	call test_process (generator, pdg_in, pdg_out, u, .true.)
	deallocate (pdg_out); deallocate (pdg_in)

	write (u, "(A)") "* Process 9: WZ production at hadron-colliders"
	allocate (pdg_in (2)); allocate (pdg_out (2))
	pdg_in(1) = 1; pdg_in(2) = -2
	pdg_out(1) = -24; pdg_out(2) = 23
	call test_process (generator, pdg_in, pdg_out, u, .true.)
	deallocate (pdg_out); deallocate (pdg_in)

	contains
	subroutine test_process (generator, pdg_in, pdg_out, u, include_initial_state)
	type(radiation_generator_t), intent(inout) :: generator
	type(pdg_array_t), dimension(:), intent(in) :: pdg_in, pdg_out
	integer, intent(in) :: u
	logical, intent(in), optional :: include_initial_state
	type(string_t), dimension(:), allocatable :: prt_strings_in
	type(string_t), dimension(:), allocatable :: prt_strings_out
	type(pdg_array_t), dimension(10) :: pdg_excluded
	logical :: yorn
	yorn = .false.
	pdg_excluded = [-4, 4, 5, -5, 6, -6, 13, -13, 15, -15]
	if (present (include_initial_state)) yorn = include_initial_state
	write (u, "(A)") "* Leading order: "
	write (u, "(A)", advance = 'no') '* Incoming: '
	call write_pdg_array (pdg_in, u)
	write (u, "(A)", advance = 'no') '* Outgoing: '
	call write_pdg_array (pdg_out, u)

	call generator%init (pdg_in, pdg_out, &
	pdg_excluded_gauge_splittings = pdg_excluded, qcd = .true., qed = .false.)
	call generator%set_n (2, size(pdg_out), 0)
	if (yorn) call generator%set_initial_state_emissions ()
	call generator%set_constraints (.false., .false., .true., .true.)
	call generator%setup_if_table (model)
	call generator%generate (prt_strings_in, prt_strings_out)
	write (u, "(A)") "* Additional radiation: "
	write (u, "(A)") "* Incoming: "
	call write_particle_string (prt_strings_in, u)
	write (u, "(A)") "* Outgoing: "
	call write_particle_string (prt_strings_out, u)
	call write_separator(u)
	call generator%reset_reshuffle_list ()
	end subroutine test_process

	end subroutine radiation_generator_1

	@ %def radiation_generator_1
	@
	<<Radiation generator: test declarations>>=
	public :: radiation_generator_2
	<<Radiation generator: tests>>=
	subroutine radiation_generator_2 (u)
	integer, intent(in) :: u
	type(radiation_generator_t) :: generator
	type(pdg_array_t), dimension(:), allocatable :: pdg_in, pdg_out
	type(pdg_array_t), dimension(:), allocatable :: pdg_excluded
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(model_t), pointer :: model => null ()
	integer, parameter :: max_multiplicity = 10
	type(string_t), dimension(:), allocatable :: prt_last

	write (u, "(A)") "* Test output: radiation_generator_2"
	write (u, "(A)") "* Purpose: Test the repeated application of &
	&a radiation generator splitting in QCD"
	write (u, "(A)") "* Only Final state emissions! "
	write (u, "(A)")
	write (u, "(A)") "* Loading radiation model: SM.mdl"

	call syntax_model_file_init ()
	call os_data%init ()
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)
	write (u, "(A)") "* Success"

	allocate (pdg_in (2))
	pdg_in(1) = 11; pdg_in(2) = -11
	allocate (pdg_out(2))
	pdg_out(1) = 2; pdg_out(2) = -2
	allocate (pdg_excluded (10))
	pdg_excluded = [-4, 4, 5, -5, 6, -6, 13, -13, 15, -15]

	write (u, "(A)") "* Leading order"
	write (u, "(A)", advance = 'no') "* Incoming: "
	call write_pdg_array (pdg_in, u)
	write (u, "(A)", advance = 'no') "* Outgoing: "
	call write_pdg_array (pdg_out, u)

	call generator%init (pdg_in, pdg_out, &
	pdg_excluded_gauge_splittings = pdg_excluded, qcd = .true., qed = .false.)
	call generator%set_n (2, 2, 0)
	call generator%set_constraints (.false., .false., .true., .true.)

	call write_separator (u)
	write (u, "(A)") "Generate higher-multiplicity states"
	write (u, "(A,I0)") "Desired multiplicity: ", max_multiplicity
	call generator%generate_multiple (max_multiplicity, model)
	call generator%prt_queue%write (u)
	call write_separator (u)
	write (u, "(A,I0)") "Number of higher-multiplicity states: ", generator%prt_queue%n_lists

	write (u, "(A)") "Check that no particle state occurs twice or more"
	if (.not. generator%prt_queue%check_for_same_prt_strings()) then
	write (u, "(A)") "SUCCESS"
	else
	write (u, "(A)") "FAIL"
	end if
	call write_separator (u)
	write (u, "(A,I0,A)") "Check that there are ", max_multiplicity, " particles in the last entry:"
	call generator%prt_queue%get_last (prt_last)
	if (size (prt_last) == max_multiplicity) then
	write (u, "(A)") "SUCCESS"
	else
	write (u, "(A)") "FAIL"
	end if
	end subroutine radiation_generator_2

	@ %def radiation_generator_2
	@
	<<Radiation generator: test declarations>>=
	public :: radiation_generator_3
	<<Radiation generator: tests>>=
	subroutine radiation_generator_3 (u)
	integer, intent(in) :: u
	type(radiation_generator_t) :: generator
	type(pdg_array_t), dimension(:), allocatable :: pdg_in, pdg_out
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(model_t), pointer :: model => null ()

	write (u, "(A)") "* Test output: radiation_generator_3"
	write (u, "(A)") "* Purpose: Create N+1-particle flavor structures &
	&from predefined N-particle flavor structures"
	write (u, "(A)") "* One additional electroweak coupling, no additional strong coupling"
	write (u, "(A)")
	write (u, "(A)") "* Loading radiation model: SM.mdl"

	call syntax_model_file_init ()
	call os_data%init ()
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)
	write (u, "(A)") "* Success"

	allocate (pdg_in (2))
	pdg_in(1) = 11; pdg_in(2) = -11

	write (u, "(A)") "* Start checking processes"
	call write_separator (u)

	write (u, "(A)") "* Process 1: Tau pair-production with additional photon"
	allocate (pdg_out(3))
	pdg_out(1) = 15; pdg_out(2) = -15; pdg_out(3) = 22
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 2: Tau pair-production with additional leptons or photon"
	allocate (pdg_out(3))
	pdg_out(1) = 15; pdg_out(2) = -15; pdg_out(3) = [-13, 13, 22]
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 3: Electron-positron production"
	allocate (pdg_out(2))
	pdg_out(1) = 11; pdg_out(2) = -11
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 4: Quark-antiquark production with additional photon"
	allocate (pdg_out(3))
	pdg_out(1) = 2; pdg_out(2) = -2; pdg_out(3) = 22
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 5: Z + jets "
	allocate (pdg_out(3))
	pdg_out(1) = 2; pdg_out(2) = -2; pdg_out(3) = 23
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 6: W + jets"
	allocate (pdg_out(3))
	pdg_out(1) = 1; pdg_out(2) = -2; pdg_out(3) = -24
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 7: Top Decay"
	allocate (pdg_out(4))
	pdg_out(1) = 24; pdg_out(2) = -24
	pdg_out(3) = 5; pdg_out(4) = -5
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 8: Production of four quarks"
	allocate (pdg_out(4))
	pdg_out(1) = 2; pdg_out(2) = -2;
	pdg_out(3) = 2; pdg_out(4) = -2
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out)

	write (u, "(A)") "* Process 9: Neutrino pair-production"
	allocate (pdg_out(2))
	pdg_out(1) = 12; pdg_out(2) = -12
	call test_process (generator, pdg_in, pdg_out, u, .true.)
	deallocate (pdg_out); deallocate (pdg_in)

	write (u, "(A)") "* Process 10: Drell-Yan lepto-production"
	allocate (pdg_in (2)); allocate (pdg_out (2))
	pdg_in(1) = 2; pdg_in(2) = -2
	pdg_out(1) = 11; pdg_out(2) = -11
	call test_process (generator, pdg_in, pdg_out, u, .true.)
	deallocate (pdg_out); deallocate (pdg_in)

	write (u, "(A)") "* Process 11: WZ production at hadron-colliders"
	allocate (pdg_in (2)); allocate (pdg_out (2))
	pdg_in(1) = 1; pdg_in(2) = -2
	pdg_out(1) = -24; pdg_out(2) = 23
	call test_process (generator, pdg_in, pdg_out, u, .true.)
	deallocate (pdg_out); deallocate (pdg_in)

	write (u, "(A)") "* Process 12: Positron-neutrino production"
	allocate (pdg_in (2)); allocate (pdg_out (2))
	pdg_in(1) = -1; pdg_in(2) = 2
	pdg_out(1) = -11; pdg_out(2) = 12
	call test_process (generator, pdg_in, pdg_out, u)
	deallocate (pdg_out); deallocate (pdg_in)

	contains
	subroutine test_process (generator, pdg_in, pdg_out, u, include_initial_state)
	type(radiation_generator_t), intent(inout) :: generator
	type(pdg_array_t), dimension(:), intent(in) :: pdg_in, pdg_out
	integer, intent(in) :: u
	logical, intent(in), optional :: include_initial_state
	type(string_t), dimension(:), allocatable :: prt_strings_in
	type(string_t), dimension(:), allocatable :: prt_strings_out
	type(pdg_array_t), dimension(10) :: pdg_excluded
	logical :: yorn
	yorn = .false.
	pdg_excluded = [-4, 4, 5, -5, 6, -6, 13, -13, 15, -15]
	if (present (include_initial_state)) yorn = include_initial_state
	write (u, "(A)") "* Leading order: "
	write (u, "(A)", advance = 'no') '* Incoming: '
	call write_pdg_array (pdg_in, u)
	write (u, "(A)", advance = 'no') '* Outgoing: '
	call write_pdg_array (pdg_out, u)

	call generator%init (pdg_in, pdg_out, &
	pdg_excluded_gauge_splittings = pdg_excluded, qcd = .false., qed = .true.)
	call generator%set_n (2, size(pdg_out), 0)
	if (yorn) call generator%set_initial_state_emissions ()
	call generator%set_constraints (.false., .false., .true., .true.)
	call generator%setup_if_table (model)
	call generator%generate (prt_strings_in, prt_strings_out)
	write (u, "(A)") "* Additional radiation: "
	write (u, "(A)") "* Incoming: "
	call write_particle_string (prt_strings_in, u)
	write (u, "(A)") "* Outgoing: "
	call write_particle_string (prt_strings_out, u)
	call write_separator(u)
	call generator%reset_reshuffle_list ()
	end subroutine test_process

	end subroutine radiation_generator_3

	@ %def radiation_generator_3
	@
	<<Radiation generator: test declarations>>=
	public :: radiation_generator_4
	<<Radiation generator: tests>>=
	subroutine radiation_generator_4 (u)
	integer, intent(in) :: u
	type(radiation_generator_t) :: generator
	type(pdg_array_t), dimension(:), allocatable :: pdg_in, pdg_out
	type(pdg_array_t), dimension(:), allocatable :: pdg_excluded
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(model_t), pointer :: model => null ()
	integer, parameter :: max_multiplicity = 10
	type(string_t), dimension(:), allocatable :: prt_last

	write (u, "(A)") "* Test output: radiation_generator_4"
	write (u, "(A)") "* Purpose: Test the repeated application of &
	&a radiation generator splitting in QED"
	write (u, "(A)") "* Only Final state emissions! "
	write (u, "(A)")
	write (u, "(A)") "* Loading radiation model: SM.mdl"

	call syntax_model_file_init ()
	call os_data%init ()
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)
	write (u, "(A)") "* Success"

	allocate (pdg_in (2))
	pdg_in(1) = 2; pdg_in(2) = -2
	allocate (pdg_out(2))
	pdg_out(1) = 11; pdg_out(2) = -11
	allocate ( pdg_excluded (14))
	pdg_excluded = [1, -1, 2, -2, 3, -3, 4, -4, 5, -5, 6, -6, 15, -15]

	write (u, "(A)") "* Leading order"
	write (u, "(A)", advance = 'no') "* Incoming: "
	call write_pdg_array (pdg_in, u)
	write (u, "(A)", advance = 'no') "* Outgoing: "
	call write_pdg_array (pdg_out, u)

	call generator%init (pdg_in, pdg_out, &
	pdg_excluded_gauge_splittings = pdg_excluded, qcd = .false., qed = .true.)
	call generator%set_n (2, 2, 0)
	call generator%set_constraints (.false., .false., .true., .true.)

	call write_separator (u)
	write (u, "(A)") "Generate higher-multiplicity states"
	write (u, "(A,I0)") "Desired multiplicity: ", max_multiplicity
	call generator%generate_multiple (max_multiplicity, model)
	call generator%prt_queue%write (u)
	call write_separator (u)
	write (u, "(A,I0)") "Number of higher-multiplicity states: ", generator%prt_queue%n_lists

	write (u, "(A)") "Check that no particle state occurs twice or more"
	if (.not. generator%prt_queue%check_for_same_prt_strings()) then
	write (u, "(A)") "SUCCESS"
	else
	write (u, "(A)") "FAIL"
	end if
	call write_separator (u)
	write (u, "(A,I0,A)") "Check that there are ", max_multiplicity, " particles in the last entry:"
	call generator%prt_queue%get_last (prt_last)
	if (size (prt_last) == max_multiplicity) then
	write (u, "(A)") "SUCCESS"
	else
	write (u, "(A)") "FAIL"
	end if
	end subroutine radiation_generator_4

	@ %def radiation_generator_4
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Sindarin Expression Implementation}

	This module defines expressions of all kinds, represented in
	a tree structure, for repeated evaluation. This provides an
	implementation of the [[expr_base]] abstract type.

	We have two flavors of expressions: one with particles and one without
	particles. The latter version is used for defining cut/selection
	criteria and for online analysis.
	<<[[eval_trees.f90]]>>=
	<<File header>>

	module eval_trees

	use, intrinsic :: iso_c_binding !NODEP!
	<<Use kinds>>
	<<Use strings>>
	use ifiles
	use lexers
	use syntax_rules
	use parser
	use pdg_arrays
	use subevents
	use var_base
	use expr_base
	use variables

	<<Standard module head>>

	<<Eval trees: public>>

	<<Eval trees: types>>

	<<Eval trees: interfaces>>

	<<Eval trees: variables>>

	interface
	<<Eval trees: sub interfaces>>
	end interface

	contains

	<<Eval trees: main procedures>>

	end module eval_trees
	@ %def eval_trees
	@
	<<[[eval_trees_sub.f90]]>>=
	<<File header>>

	submodule (eval_trees) eval_trees_s

	use io_units
	use constants, only: DEGREE, IMAGO, PI
	use format_defs, only: FMT_19
	use numeric_utils, only: nearly_equal
	use diagnostics
	use lorentz
	use md5
	use formats
	use sorting
	use analysis
	use jets
	use observables

	implicit none

	contains

	<<Eval trees: procedures>>

	end submodule eval_trees_s

	@ %def eval_trees_s
	@
	\subsection{Tree nodes}
	The evaluation tree consists of branch nodes (unary and binary) and of
	leaf nodes, originating from a common root. The node object should be
	polymorphic. For the time being, polymorphism is emulated here. This
	means that we have to maintain all possibilities that the node may
	hold, including associated procedures as pointers.

	The following parameter values characterize the node. Unary and
	binary operators have sub-nodes. The other are leaf nodes. Possible
	leafs are literal constants or named-parameter references.
	<<Eval trees: types>>=
	integer, parameter :: EN_UNKNOWN = 0, EN_UNARY = 1, EN_BINARY = 2
	integer, parameter :: EN_CONSTANT = 3, EN_VARIABLE = 4
	integer, parameter :: EN_CONDITIONAL = 5, EN_BLOCK = 6
	integer, parameter :: EN_RECORD_CMD = 7
	integer, parameter :: EN_OBS1_INT = 11, EN_OBS2_INT = 12
	integer, parameter :: EN_OBSEV_INT = 13
	integer, parameter :: EN_OBS1_REAL = 21, EN_OBS2_REAL = 22
	integer, parameter :: EN_OBSEV_REAL = 23
	integer, parameter :: EN_PRT_FUN_UNARY = 101, EN_PRT_FUN_BINARY = 102
	integer, parameter :: EN_EVAL_FUN_UNARY = 111, EN_EVAL_FUN_BINARY = 112
	integer, parameter :: EN_LOG_FUN_UNARY = 121, EN_LOG_FUN_BINARY = 122
	integer, parameter :: EN_INT_FUN_UNARY = 131, EN_INT_FUN_BINARY = 132
	integer, parameter :: EN_REAL_FUN_UNARY = 141, EN_REAL_FUN_BINARY = 142
	integer, parameter :: EN_REAL_FUN_CUM = 151
	integer, parameter :: EN_FORMAT_STR = 161

	@ %def EN_UNKNOWN EN_UNARY EN_BINARY EN_CONSTANT EN_VARIABLE EN_CONDITIONAL
	@ %def EN_RECORD_CMD
	@ %def EN_OBS1_INT EN_OBS2_INT EN_OBS1_REAL EN_OBS2_REAL EN_OBSEV_INT EN_OBSEV_REAL
	@ %def EN_PRT_FUN_UNARY EN_PRT_FUN_BINARY
	@ %def EN_EVAL_FUN_UNARY EN_EVAL_FUN_BINARY
	@ %def EN_LOG_FUN_UNARY EN_LOG_FUN_BINARY
	@ %def EN_INT_FUN_UNARY EN_INT_FUN_BINARY
	@ %def EN_REAL_FUN_UNARY EN_REAL_FUN_BINARY
	@ %def EN_REAL_FUN_CUM
	@ %def EN_FORMAT_STR
	@ This is exported only for use within unit tests.
	<<Eval trees: public>>=
	public :: eval_node_t
	<<Eval trees: types>>=
	type :: eval_node_t
	private
	type(string_t) :: tag
	integer :: type = EN_UNKNOWN
	integer :: result_type = V_NONE
	type(var_list_t), pointer :: var_list => null ()
	type(string_t) :: var_name
	logical, pointer :: value_is_known => null ()
	logical, pointer :: lval => null ()
	integer, pointer :: ival => null ()
	real(default), pointer :: rval => null ()
	complex(default), pointer :: cval => null ()
	type(subevt_t), pointer :: pval => null ()
	type(pdg_array_t), pointer :: aval => null ()
	type(string_t), pointer :: sval => null ()
	type(eval_node_t), pointer :: arg0 => null ()
	type(eval_node_t), pointer :: arg1 => null ()
	type(eval_node_t), pointer :: arg2 => null ()
	type(eval_node_t), pointer :: arg3 => null ()
	type(eval_node_t), pointer :: arg4 => null ()
	procedure(obs_unary_int), nopass, pointer :: obs1_int => null ()
	procedure(obs_unary_real), nopass, pointer :: obs1_real => null ()
	procedure(obs_binary_int), nopass, pointer :: obs2_int => null ()
	procedure(obs_binary_real), nopass, pointer :: obs2_real => null ()
	procedure(obs_sev_int), nopass, pointer :: obsev_int => null ()
	procedure(obs_sev_real), nopass, pointer :: obsev_real => null ()
	integer, pointer :: prt_type => null ()
	integer, pointer :: index => null ()
	real(default), pointer :: tolerance => null ()
	integer, pointer :: jet_algorithm => null ()
	real(default), pointer :: jet_r => null ()
	real(default), pointer :: jet_p => null ()
	real(default), pointer :: jet_ycut => null ()
	real(default), pointer :: jet_dcut => null ()
	real(default), pointer :: photon_iso_eps => null ()
	real(default), pointer :: photon_iso_n => null ()
	real(default), pointer :: photon_iso_r0 => null ()
	real(default), pointer :: photon_rec_r0 => null ()
	type(prt_t), pointer :: prt1 => null ()
	type(prt_t), pointer :: prt2 => null ()
	procedure(unary_log), nopass, pointer :: op1_log => null ()
	procedure(unary_int), nopass, pointer :: op1_int => null ()
	procedure(unary_real), nopass, pointer :: op1_real => null ()
	procedure(unary_cmplx), nopass, pointer :: op1_cmplx => null ()
	procedure(unary_pdg), nopass, pointer :: op1_pdg => null ()
	procedure(unary_sev), nopass, pointer :: op1_sev => null ()
	procedure(unary_str), nopass, pointer :: op1_str => null ()
	procedure(unary_cut), nopass, pointer :: op1_cut => null ()
	procedure(unary_evi), nopass, pointer :: op1_evi => null ()
	procedure(unary_evr), nopass, pointer :: op1_evr => null ()
	procedure(binary_log), nopass, pointer :: op2_log => null ()
	procedure(binary_int), nopass, pointer :: op2_int => null ()
	procedure(binary_real), nopass, pointer :: op2_real => null ()
	procedure(binary_cmplx), nopass, pointer :: op2_cmplx => null ()
	procedure(binary_pdg), nopass, pointer :: op2_pdg => null ()
	procedure(binary_sev), nopass, pointer :: op2_sev => null ()
	procedure(binary_str), nopass, pointer :: op2_str => null ()
	procedure(binary_cut), nopass, pointer :: op2_cut => null ()
	procedure(binary_evi), nopass, pointer :: op2_evi => null ()
	procedure(binary_evr), nopass, pointer :: op2_evr => null ()
	procedure(cum_evi), nopass, pointer :: opcum_evi => null ()
	procedure(cum_evr), nopass, pointer :: opcum_evr => null ()
	contains
	<<Eval trees: eval node: TBP>>
	end type eval_node_t

	@ %def eval_node_t
	@ Finalize a node recursively. Allocated constants are deleted,
	pointers are ignored.
	<<Eval trees: eval node: TBP>>=
	procedure :: final_rec => eval_node_final_rec
	<<Eval trees: sub interfaces>>=
	recursive module subroutine eval_node_final_rec (node)
	class(eval_node_t), intent(inout) :: node
	end subroutine eval_node_final_rec
	<<Eval trees: procedures>>=
	recursive module subroutine eval_node_final_rec (node)
	class(eval_node_t), intent(inout) :: node
	select case (node%type)
	case (EN_UNARY)
	call eval_node_final_rec (node%arg1)
	case (EN_BINARY)
	call eval_node_final_rec (node%arg1)
	call eval_node_final_rec (node%arg2)
	case (EN_CONDITIONAL)
	call eval_node_final_rec (node%arg0)
	call eval_node_final_rec (node%arg1)
	call eval_node_final_rec (node%arg2)
	case (EN_BLOCK)
	call eval_node_final_rec (node%arg0)
	call eval_node_final_rec (node%arg1)
	case (EN_PRT_FUN_UNARY, EN_EVAL_FUN_UNARY, &
	EN_LOG_FUN_UNARY, EN_INT_FUN_UNARY, EN_REAL_FUN_UNARY)
	if (associated (node%arg0)) call eval_node_final_rec (node%arg0)
	call eval_node_final_rec (node%arg1)
	deallocate (node%index)
	deallocate (node%prt1)
	case (EN_REAL_FUN_CUM)
	if (associated (node%arg0)) call eval_node_final_rec (node%arg0)
	call eval_node_final_rec (node%arg1)
	deallocate (node%index)
	deallocate (node%prt1)
	case (EN_PRT_FUN_BINARY, EN_EVAL_FUN_BINARY, &
	EN_LOG_FUN_BINARY, EN_INT_FUN_BINARY, EN_REAL_FUN_BINARY)
	if (associated (node%arg0)) call eval_node_final_rec (node%arg0)
	call eval_node_final_rec (node%arg1)
	call eval_node_final_rec (node%arg2)
	deallocate (node%index)
	deallocate (node%prt1)
	deallocate (node%prt2)
	case (EN_FORMAT_STR)
	if (associated (node%arg0)) call eval_node_final_rec (node%arg0)
	if (associated (node%arg1)) call eval_node_final_rec (node%arg1)
	deallocate (node%ival)
	case (EN_RECORD_CMD)
	if (associated (node%arg0)) call eval_node_final_rec (node%arg0)
	if (associated (node%arg1)) call eval_node_final_rec (node%arg1)
	if (associated (node%arg2)) call eval_node_final_rec (node%arg2)
	if (associated (node%arg3)) call eval_node_final_rec (node%arg3)
	if (associated (node%arg4)) call eval_node_final_rec (node%arg4)
	end select
	select case (node%type)
	case (EN_UNARY, EN_BINARY, EN_CONDITIONAL, EN_CONSTANT, EN_BLOCK, &
	EN_PRT_FUN_UNARY, EN_PRT_FUN_BINARY, &
	EN_EVAL_FUN_UNARY, EN_EVAL_FUN_BINARY, &
	EN_LOG_FUN_UNARY, EN_LOG_FUN_BINARY, &
	EN_INT_FUN_UNARY, EN_INT_FUN_BINARY, &
	EN_REAL_FUN_UNARY, EN_REAL_FUN_BINARY, &
	EN_REAL_FUN_CUM, &
	EN_FORMAT_STR, EN_RECORD_CMD)
	select case (node%result_type)
	case (V_LOG); deallocate (node%lval)
	case (V_INT); deallocate (node%ival)
	case (V_REAL); deallocate (node%rval)
	case (V_CMPLX); deallocate (node%cval)
	case (V_SEV); deallocate (node%pval)
	case (V_PDG); deallocate (node%aval)
	case (V_STR); deallocate (node%sval)
	end select
	deallocate (node%value_is_known)
	end select
	end subroutine eval_node_final_rec

	@ %def eval_node_final_rec
	@
	\subsubsection{Leaf nodes}
	Initialize a leaf node with a literal constant.
	<<Eval trees: procedures>>=
	subroutine eval_node_init_log (node, lval)
	type(eval_node_t), intent(out) :: node
	logical, intent(in) :: lval
	node%type = EN_CONSTANT
	node%result_type = V_LOG
	allocate (node%lval, node%value_is_known)
	node%lval = lval
	node%value_is_known = .true.
	end subroutine eval_node_init_log

	subroutine eval_node_init_int (node, ival)
	type(eval_node_t), intent(out) :: node
	integer, intent(in) :: ival
	node%type = EN_CONSTANT
	node%result_type = V_INT
	allocate (node%ival, node%value_is_known)
	node%ival = ival
	node%value_is_known = .true.
	end subroutine eval_node_init_int

	subroutine eval_node_init_real (node, rval)
	type(eval_node_t), intent(out) :: node
	real(default), intent(in) :: rval
	node%type = EN_CONSTANT
	node%result_type = V_REAL
	allocate (node%rval, node%value_is_known)
	node%rval = rval
	node%value_is_known = .true.
	end subroutine eval_node_init_real

	subroutine eval_node_init_cmplx (node, cval)
	type(eval_node_t), intent(out) :: node
	complex(default), intent(in) :: cval
	node%type = EN_CONSTANT
	node%result_type = V_CMPLX
	allocate (node%cval, node%value_is_known)
	node%cval = cval
	node%value_is_known = .true.
	end subroutine eval_node_init_cmplx

	subroutine eval_node_init_subevt (node, pval)
	type(eval_node_t), intent(out) :: node
	type(subevt_t), intent(in) :: pval
	node%type = EN_CONSTANT
	node%result_type = V_SEV
	allocate (node%pval, node%value_is_known)
	node%pval = pval
	node%value_is_known = .true.
	end subroutine eval_node_init_subevt

	subroutine eval_node_init_pdg_array (node, aval)
	type(eval_node_t), intent(out) :: node
	type(pdg_array_t), intent(in) :: aval
	node%type = EN_CONSTANT
	node%result_type = V_PDG
	allocate (node%aval, node%value_is_known)
	node%aval = aval
	node%value_is_known = .true.
	end subroutine eval_node_init_pdg_array

	subroutine eval_node_init_string (node, sval)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: sval
	node%type = EN_CONSTANT
	node%result_type = V_STR
	allocate (node%sval, node%value_is_known)
	node%sval = sval
	node%value_is_known = .true.
	end subroutine eval_node_init_string

	@ %def eval_node_init_log eval_node_init_int eval_node_init_real
	@ %def eval_node_init_cmplx eval_node_init_prt eval_node_init_subevt
	@ %def eval_node_init_pdg_array eval_node_init_string
	@ Initialize a leaf node with a pointer to a named parameter
	<<Eval trees: procedures>>=
	subroutine eval_node_init_log_ptr (node, name, lval, is_known)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	logical, intent(in), target :: lval
	logical, intent(in), target :: is_known
	node%type = EN_VARIABLE
	node%tag = name
	node%result_type = V_LOG
	node%lval => lval
	node%value_is_known => is_known
	end subroutine eval_node_init_log_ptr

	subroutine eval_node_init_int_ptr (node, name, ival, is_known)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	integer, intent(in), target :: ival
	logical, intent(in), target :: is_known
	node%type = EN_VARIABLE
	node%tag = name
	node%result_type = V_INT
	node%ival => ival
	node%value_is_known => is_known
	end subroutine eval_node_init_int_ptr

	subroutine eval_node_init_real_ptr (node, name, rval, is_known)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	real(default), intent(in), target :: rval
	logical, intent(in), target :: is_known
	node%type = EN_VARIABLE
	node%tag = name
	node%result_type = V_REAL
	node%rval => rval
	node%value_is_known => is_known
	end subroutine eval_node_init_real_ptr

	subroutine eval_node_init_cmplx_ptr (node, name, cval, is_known)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	complex(default), intent(in), target :: cval
	logical, intent(in), target :: is_known
	node%type = EN_VARIABLE
	node%tag = name
	node%result_type = V_CMPLX
	node%cval => cval
	node%value_is_known => is_known
	end subroutine eval_node_init_cmplx_ptr

	subroutine eval_node_init_subevt_ptr (node, name, pval, is_known)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in), target :: pval
	logical, intent(in), target :: is_known
	node%type = EN_VARIABLE
	node%tag = name
	node%result_type = V_SEV
	node%pval => pval
	node%value_is_known => is_known
	end subroutine eval_node_init_subevt_ptr

	subroutine eval_node_init_pdg_array_ptr (node, name, aval, is_known)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in), target :: aval
	logical, intent(in), target :: is_known
	node%type = EN_VARIABLE
	node%tag = name
	node%result_type = V_PDG
	node%aval => aval
	node%value_is_known => is_known
	end subroutine eval_node_init_pdg_array_ptr

	subroutine eval_node_init_string_ptr (node, name, sval, is_known)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	type(string_t), intent(in), target :: sval
	logical, intent(in), target :: is_known
	node%type = EN_VARIABLE
	node%tag = name
	node%result_type = V_STR
	node%sval => sval
	node%value_is_known => is_known
	end subroutine eval_node_init_string_ptr

	@ %def eval_node_init_log_ptr eval_node_init_int_ptr
	@ %def eval_node_init_real_ptr eval_node_init_cmplx_ptr
	@ %def eval_node_init_subevt_ptr eval_node_init_string_ptr
	@ The procedure-pointer cases:
	<<Eval trees: procedures>>=
	subroutine eval_node_init_obs1_int_ptr (node, name, obs1_iptr, p1)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	procedure(obs_unary_int), intent(in), pointer :: obs1_iptr
	type(prt_t), intent(in), target :: p1
	node%type = EN_OBS1_INT
	node%tag = name
	node%result_type = V_INT
	node%obs1_int => obs1_iptr
	node%prt1 => p1
	allocate (node%ival, node%value_is_known)
	node%value_is_known = .false.
	end subroutine eval_node_init_obs1_int_ptr

	subroutine eval_node_init_obs2_int_ptr (node, name, obs2_iptr, p1, p2)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	procedure(obs_binary_int), intent(in), pointer :: obs2_iptr
	type(prt_t), intent(in), target :: p1, p2
	node%type = EN_OBS2_INT
	node%tag = name
	node%result_type = V_INT
	node%obs2_int => obs2_iptr
	node%prt1 => p1
	node%prt2 => p2
	allocate (node%ival, node%value_is_known)
	node%value_is_known = .false.
	end subroutine eval_node_init_obs2_int_ptr

	subroutine eval_node_init_obsev_int_ptr (node, name, obsev_iptr, pval)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	procedure(obs_sev_int), intent(in), pointer :: obsev_iptr
	type(subevt_t), intent(in), target :: pval
	node%type = EN_OBSEV_INT
	node%tag = name
	node%result_type = V_INT
	node%obsev_int => obsev_iptr
	node%pval => pval
	allocate (node%rval, node%value_is_known)
	node%value_is_known = .false.
	end subroutine eval_node_init_obsev_int_ptr

	subroutine eval_node_init_obs1_real_ptr (node, name, obs1_rptr, p1)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	procedure(obs_unary_real), intent(in), pointer :: obs1_rptr
	type(prt_t), intent(in), target :: p1
	node%type = EN_OBS1_REAL
	node%tag = name
	node%result_type = V_REAL
	node%obs1_real => obs1_rptr
	node%prt1 => p1
	allocate (node%rval, node%value_is_known)
	node%value_is_known = .false.
	end subroutine eval_node_init_obs1_real_ptr

	subroutine eval_node_init_obs2_real_ptr (node, name, obs2_rptr, p1, p2)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	procedure(obs_binary_real), intent(in), pointer :: obs2_rptr
	type(prt_t), intent(in), target :: p1, p2
	node%type = EN_OBS2_REAL
	node%tag = name
	node%result_type = V_REAL
	node%obs2_real => obs2_rptr
	node%prt1 => p1
	node%prt2 => p2
	allocate (node%rval, node%value_is_known)
	node%value_is_known = .false.
	end subroutine eval_node_init_obs2_real_ptr

	subroutine eval_node_init_obsev_real_ptr (node, name, obsev_rptr, pval)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: name
	procedure(obs_sev_real), intent(in), pointer :: obsev_rptr
	type(subevt_t), intent(in), target :: pval
	node%type = EN_OBSEV_REAL
	node%tag = name
	node%result_type = V_REAL
	node%obsev_real => obsev_rptr
	node%pval => pval
	allocate (node%rval, node%value_is_known)
	node%value_is_known = .false.
	end subroutine eval_node_init_obsev_real_ptr

	@ %def eval_node_init_obs1_int_ptr
	@ %def eval_node_init_obs2_int_ptr
	@ %def eval_node_init_obs1_real_ptr
	@ %def eval_node_init_obs2_real_ptr
	@ %def eval_node_init_obsev_int_ptr
	@ %def eval_node_init_obsev_real_ptr
	@
	\subsubsection{Branch nodes}
	Initialize a branch node, sub-nodes are given.
	<<Eval trees: procedures>>=
	subroutine eval_node_init_branch (node, tag, result_type, arg1, arg2)
	type(eval_node_t), intent(out) :: node
	type(string_t), intent(in) :: tag
	integer, intent(in) :: result_type
	type(eval_node_t), intent(in), target :: arg1
	type(eval_node_t), intent(in), target, optional :: arg2
	if (present (arg2)) then
	node%type = EN_BINARY
	else
	node%type = EN_UNARY
	end if
	node%tag = tag
	node%result_type = result_type
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	if (present (arg2)) node%arg2 => arg2
	end subroutine eval_node_init_branch

	@ %def eval_node_init_branch
	@ Allocate the node value according to the result type.
	<<Eval trees: procedures>>=
	subroutine eval_node_allocate_value (node)
	type(eval_node_t), intent(inout) :: node
	select case (node%result_type)
	case (V_LOG); allocate (node%lval)
	case (V_INT); allocate (node%ival)
	case (V_REAL); allocate (node%rval)
	case (V_CMPLX); allocate (node%cval)
	case (V_PDG); allocate (node%aval)
	case (V_SEV); allocate (node%pval)
	call subevt_init (node%pval)
	case (V_STR); allocate (node%sval)
	end select
	allocate (node%value_is_known)
	node%value_is_known = .false.
	end subroutine eval_node_allocate_value

	@ %def eval_node_allocate_value
	@ Initialize a block node which contains, in addition to the
	expression to be evaluated, a variable definition. The result type is
	not yet assigned, because we can compile the enclosed expression only
	after the var list is set up.

	Note that the node always allocates a new variable list and appends it to the
	current one. Thus, if the variable redefines an existing one, it only shadows
	it but does not reset it. Any side-effects are therefore absent and need not
	be undone outside the block.

	If the flag [[new]] is set, a variable is (re)declared. This must not be done
	for intrinsic variables. Vice versa, if the variable is not existent, the
	[[new]] flag is required.
	<<Eval trees: procedures>>=
	subroutine eval_node_init_block (node, name, type, var_def, var_list)
	type(eval_node_t), intent(out), target :: node
	type(string_t), intent(in) :: name
	integer, intent(in) :: type
	type(eval_node_t), intent(in), target :: var_def
	type(var_list_t), intent(in), target :: var_list
	node%type = EN_BLOCK
	node%tag = "var_def"
	node%var_name = name
	node%arg1 => var_def
	allocate (node%var_list)
	call node%var_list%link (var_list)
	if (var_def%type == EN_CONSTANT) then
	select case (type)
	case (V_LOG)
	call node%var_list%append_log (name, var_def%lval)
	case (V_INT)
	call node%var_list%append_int (name, var_def%ival)
	case (V_REAL)
	call node%var_list%append_real (name, var_def%rval)
	case (V_CMPLX)
	call node%var_list%append_cmplx (name, var_def%cval)
	case (V_PDG)
	call node%var_list%append_pdg_array (name, var_def%aval)
	case (V_SEV)
	call node%var_list%append_subevt (name, var_def%pval)
	case (V_STR)
	call node%var_list%append_string (name, var_def%sval)
	end select
	else
	select case (type)
	case (V_LOG); call node%var_list%append_log_ptr &
	(name, var_def%lval, var_def%value_is_known)
	case (V_INT); call node%var_list%append_int_ptr &
	(name, var_def%ival, var_def%value_is_known)
	case (V_REAL); call node%var_list%append_real_ptr &
	(name, var_def%rval, var_def%value_is_known)
	case (V_CMPLX); call node%var_list%append_cmplx_ptr &
	(name, var_def%cval, var_def%value_is_known)
	case (V_PDG); call node%var_list%append_pdg_array_ptr &
	(name, var_def%aval, var_def%value_is_known)
	case (V_SEV); call node%var_list%append_subevt_ptr &
	(name, var_def%pval, var_def%value_is_known)
	case (V_STR); call node%var_list%append_string_ptr &
	(name, var_def%sval, var_def%value_is_known)
	end select
	end if
	end subroutine eval_node_init_block

	@ %def eval_node_init_block
	@ Complete block initialization by assigning the expression to
	evaluate to [[arg0]].
	<<Eval trees: procedures>>=
	subroutine eval_node_set_expr (node, arg, result_type)
	type(eval_node_t), intent(inout) :: node
	type(eval_node_t), intent(in), target :: arg
	integer, intent(in), optional :: result_type
	if (present (result_type)) then
	node%result_type = result_type
	else
	node%result_type = arg%result_type
	end if
	call eval_node_allocate_value (node)
	node%arg0 => arg
	end subroutine eval_node_set_expr

	@ %def eval_node_set_block_expr
	@ Initialize a conditional. There are three branches: the condition
	(evaluates to logical) and the two alternatives (evaluate both to the
	same arbitrary type).
	<<Eval trees: procedures>>=
	subroutine eval_node_init_conditional (node, result_type, cond, arg1, arg2)
	type(eval_node_t), intent(out) :: node
	integer, intent(in) :: result_type
	type(eval_node_t), intent(in), target :: cond, arg1, arg2
	node%type = EN_CONDITIONAL
	node%tag = "cond"
	node%result_type = result_type
	call eval_node_allocate_value (node)
	node%arg0 => cond
	node%arg1 => arg1
	node%arg2 => arg2
	end subroutine eval_node_init_conditional

	@ %def eval_node_init_conditional
	@ Initialize a recording command (which evaluates to a logical
	constant). The first branch is the ID of the analysis object to be
	filled, the optional branches 1 to 4 are the values to be recorded.

	If the event-weight pointer is null, we record values with unit weight.
	Otherwise, we use the value pointed to as event weight.

	There can be up to four arguments which represent $x$, $y$, $\Delta y$,
	$\Delta x$. Therefore, this is the only node type that may fill four
	sub-nodes.
	<<Eval trees: procedures>>=
	subroutine eval_node_init_record_cmd &
	(node, event_weight, id, arg1, arg2, arg3, arg4)
	type(eval_node_t), intent(out) :: node
	real(default), pointer :: event_weight
	type(eval_node_t), intent(in), target :: id
	type(eval_node_t), intent(in), optional, target :: arg1, arg2, arg3, arg4
	call eval_node_init_log (node, .true.)
	node%type = EN_RECORD_CMD
	node%rval => event_weight
	node%tag = "record_cmd"
	node%arg0 => id
	if (present (arg1)) then
	node%arg1 => arg1
	if (present (arg2)) then
	node%arg2 => arg2
	if (present (arg3)) then
	node%arg3 => arg3
	if (present (arg4)) then
	node%arg4 => arg4
	end if
	end if
	end if
	end if
	end subroutine eval_node_init_record_cmd

	@ %def eval_node_init_record_cmd
	@ Initialize a node for operations on subevents. The particle
	lists (one or two) are inserted as [[arg1]] and [[arg2]]. We
	allocated particle pointers as temporaries for iterating over particle
	lists. The procedure pointer which holds the function to evaluate for
	the subevents (e.g., combine, select) is also initialized.
	<<Eval trees: procedures>>=
	subroutine eval_node_init_prt_fun_unary (node, arg1, name, proc)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), intent(in), target :: arg1
	type(string_t), intent(in) :: name
	procedure(unary_sev) :: proc
	node%type = EN_PRT_FUN_UNARY
	node%tag = name
	node%result_type = V_SEV
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	allocate (node%index, source = 0)
	allocate (node%prt1)
	node%op1_sev => proc
	end subroutine eval_node_init_prt_fun_unary

	subroutine eval_node_init_prt_fun_binary (node, arg1, arg2, name, proc)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), intent(in), target :: arg1, arg2
	type(string_t), intent(in) :: name
	procedure(binary_sev) :: proc
	node%type = EN_PRT_FUN_BINARY
	node%tag = name
	node%result_type = V_SEV
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	node%arg2 => arg2
	allocate (node%index, source = 0)
	allocate (node%prt1)
	allocate (node%prt2)
	node%op2_sev => proc
	end subroutine eval_node_init_prt_fun_binary

	@ %def eval_node_init_prt_fun_unary eval_node_init_prt_fun_binary
	@ Similar, but for particle-list functions that evaluate to a real
	value.
	<<Eval trees: procedures>>=
	subroutine eval_node_init_eval_fun_unary (node, arg1, name)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), intent(in), target :: arg1
	type(string_t), intent(in) :: name
	node%type = EN_EVAL_FUN_UNARY
	node%tag = name
	node%result_type = V_REAL
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	allocate (node%index, source = 0)
	allocate (node%prt1)
	end subroutine eval_node_init_eval_fun_unary

	subroutine eval_node_init_eval_fun_binary (node, arg1, arg2, name)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), intent(in), target :: arg1, arg2
	type(string_t), intent(in) :: name
	node%type = EN_EVAL_FUN_BINARY
	node%tag = name
	node%result_type = V_REAL
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	node%arg2 => arg2
	allocate (node%index, source = 0)
	allocate (node%prt1)
	allocate (node%prt2)
	end subroutine eval_node_init_eval_fun_binary

	@ %def eval_node_init_eval_fun_unary eval_node_init_eval_fun_binary
	@ These are for particle-list functions that evaluate to a logical
	value.
	<<Eval trees: procedures>>=
	subroutine eval_node_init_log_fun_unary (node, arg1, name, proc)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), intent(in), target :: arg1
	type(string_t), intent(in) :: name
	procedure(unary_cut) :: proc
	node%type = EN_LOG_FUN_UNARY
	node%tag = name
	node%result_type = V_LOG
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	allocate (node%index, source = 0)
	allocate (node%prt1)
	node%op1_cut => proc
	end subroutine eval_node_init_log_fun_unary

	subroutine eval_node_init_log_fun_binary (node, arg1, arg2, name, proc)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), intent(in), target :: arg1, arg2
	type(string_t), intent(in) :: name
	procedure(binary_cut) :: proc
	node%type = EN_LOG_FUN_BINARY
	node%tag = name
	node%result_type = V_LOG
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	node%arg2 => arg2
	allocate (node%index, source = 0)
	allocate (node%prt1)
	allocate (node%prt2)
	node%op2_cut => proc
	end subroutine eval_node_init_log_fun_binary

	@ %def eval_node_init_log_fun_unary eval_node_init_log_fun_binary
	@ These are for particle-list functions that evaluate to an integer
	value.
	<<Eval trees: procedures>>=
	subroutine eval_node_init_int_fun_unary (node, arg1, name, proc)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), intent(in), target :: arg1
	type(string_t), intent(in) :: name
	procedure(unary_evi) :: proc
	node%type = EN_INT_FUN_UNARY
	node%tag = name
	node%result_type = V_INT
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	allocate (node%index, source = 0)
	allocate (node%prt1)
	node%op1_evi => proc
	end subroutine eval_node_init_int_fun_unary

	subroutine eval_node_init_int_fun_binary (node, arg1, arg2, name, proc)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), intent(in), target :: arg1, arg2
	type(string_t), intent(in) :: name
	procedure(binary_evi) :: proc
	node%type = EN_INT_FUN_BINARY
	node%tag = name
	node%result_type = V_INT
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	node%arg2 => arg2
	allocate (node%index, source = 0)
	allocate (node%prt1)
	allocate (node%prt2)
	node%op2_evi => proc
	end subroutine eval_node_init_int_fun_binary

	@ %def eval_node_init_int_fun_unary eval_node_init_int_fun_binary
	@ These are for particle-list functions that evaluate to a real
	value.
	<<Eval trees: procedures>>=
	subroutine eval_node_init_real_fun_unary (node, arg1, name, proc)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), intent(in), target :: arg1
	type(string_t), intent(in) :: name
	procedure(unary_evr) :: proc
	node%type = EN_REAL_FUN_UNARY
	node%tag = name
	node%result_type = V_REAL
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	allocate (node%index, source = 0)
	allocate (node%prt1)
	node%op1_evr => proc
	end subroutine eval_node_init_real_fun_unary

	subroutine eval_node_init_real_fun_binary (node, arg1, arg2, name, proc)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), intent(in), target :: arg1, arg2
	type(string_t), intent(in) :: name
	procedure(binary_evr) :: proc
	node%type = EN_REAL_FUN_BINARY
	node%tag = name
	node%result_type = V_REAL
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	node%arg2 => arg2
	allocate (node%index, source = 0)
	allocate (node%prt1)
	allocate (node%prt2)
	node%op2_evr => proc
	end subroutine eval_node_init_real_fun_binary

	subroutine eval_node_init_real_fun_cum (node, arg1, name, proc)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), intent(in), target :: arg1
	type(string_t), intent(in) :: name
	procedure(cum_evr) :: proc
	node%type = EN_REAL_FUN_CUM
	node%tag = name
	node%result_type = V_REAL
	call eval_node_allocate_value (node)
	node%arg1 => arg1
	allocate (node%index, source = 0)
	allocate (node%prt1)
	node%opcum_evr => proc
	end subroutine eval_node_init_real_fun_cum

	@ %def eval_node_init_real_fun_unary eval_node_init_real_fun_binary
	@ %def eval_node_init_real_fun_cum
	@ Initialize a node for a string formatting function (sprintf).
	<<Eval trees: procedures>>=
	subroutine eval_node_init_format_string (node, fmt, arg, name, n_args)
	type(eval_node_t), intent(out) :: node
	type(eval_node_t), pointer :: fmt, arg
	type(string_t), intent(in) :: name
	integer, intent(in) :: n_args
	node%type = EN_FORMAT_STR
	node%tag = name
	node%result_type = V_STR
	call eval_node_allocate_value (node)
	node%arg0 => fmt
	node%arg1 => arg
	allocate (node%ival)
	node%ival = n_args
	end subroutine eval_node_init_format_string

	@ %def eval_node_init_format_string
	@ If particle functions depend upon a condition (or an expression is
	evaluated), the observables that can be evaluated for the given
	particles have to be thrown on the local variable stack. This is done
	here. Each observable is initialized with the particle pointers which
	have been allocated for the node.

	The integer variable that is referred to by the [[Index]]
	pseudo-observable is always known when it is referred to.
	<<Eval trees: procedures>>=
	subroutine eval_node_set_observables (node, var_list)
	type(eval_node_t), intent(inout) :: node
	type(var_list_t), intent(in), target :: var_list
	logical, save, target :: known = .true.
	allocate (node%var_list)
	call node%var_list%link (var_list)
	allocate (node%index, source = 0)
	call node%var_list%append_int_ptr &
	(var_str ("Index"), node%index, known, intrinsic=.true.)
	if (.not. associated (node%prt2)) then
	call var_list_set_observables_unary &
	(node%var_list, node%prt1)
	if (associated (node%pval)) then
	call var_list_set_observables_sev &
	(node%var_list, node%pval)
	end if
	else
	call var_list_set_observables_binary &
	(node%var_list, node%prt1, node%prt2)
	end if
	end subroutine eval_node_set_observables

	@ %def eval_node_set_observables
	@
	\subsubsection{Output}
	<<Eval trees: eval node: TBP>>=
	procedure :: write => eval_node_write
	<<Eval trees: sub interfaces>>=
	module subroutine eval_node_write (node, unit, indent)
	class(eval_node_t), intent(in) :: node
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: indent
	end subroutine eval_node_write
	<<Eval trees: procedures>>=
	module subroutine eval_node_write (node, unit, indent)
	class(eval_node_t), intent(in) :: node
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: indent
	integer :: u, ind
	u = given_output_unit (unit); if (u < 0) return
	ind = 0; if (present (indent)) ind = indent
	write (u, "(A)", advance="no") repeat ("\| ", ind) // "o "
	select case (node%type)
	case (EN_UNARY, EN_BINARY, EN_CONDITIONAL, &
	EN_PRT_FUN_UNARY, EN_PRT_FUN_BINARY, &
	EN_EVAL_FUN_UNARY, EN_EVAL_FUN_BINARY, &
	EN_LOG_FUN_UNARY, EN_LOG_FUN_BINARY, &
	EN_INT_FUN_UNARY, EN_INT_FUN_BINARY, &
	EN_REAL_FUN_UNARY, EN_REAL_FUN_BINARY, &
	EN_REAL_FUN_CUM)
	write (u, "(A)", advance="no") "[" // char (node%tag) // "] ="
	case (EN_CONSTANT)
	write (u, "(A)", advance="no") "[const] ="
	case (EN_VARIABLE)
	write (u, "(A)", advance="no") char (node%tag) // " =>"
	case (EN_OBS1_INT, EN_OBS2_INT, EN_OBS1_REAL, EN_OBS2_REAL)
	write (u, "(A)", advance="no") char (node%tag) // " ="
	case (EN_BLOCK)
	write (u, "(A)", advance="no") "[" // char (node%tag) // "]" // &
	char (node%var_name) // " [expr] = "
	case default
	write (u, "(A)", advance="no") "[???] ="
	end select
	select case (node%result_type)
	case (V_LOG)
	if (node%value_is_known) then
	if (node%lval) then
	write (u, "(1x,A)") "true"
	else
	write (u, "(1x,A)") "false"
	end if
	else
	write (u, "(1x,A)") "[unknown logical]"
	end if
	case (V_INT)
	if (node%value_is_known) then
	write (u, "(1x,I0)") node%ival
	else
	write (u, "(1x,A)") "[unknown integer]"
	end if
	case (V_REAL)
	if (node%value_is_known) then
	write (u, "(1x," // FMT_19 // ")") node%rval
	else
	write (u, "(1x,A)") "[unknown real]"
	end if
	case (V_CMPLX)
	if (node%value_is_known) then
	write (u, "(1x,'('," // FMT_19 // ",','," // &
	FMT_19 // ",')')") node%cval
	else
	write (u, "(1x,A)") "[unknown complex]"
	end if
	case (V_SEV)
	if (char (node%tag) == "@evt") then
	write (u, "(1x,A)") "[event subevent]"
	else if (node%value_is_known) then
	call node%pval%write (unit, prefix = repeat ("\| ", ind + 1))
	else
	write (u, "(1x,A)") "[unknown subevent]"
	end if
	case (V_PDG)
	write (u, "(1x)", advance="no")
	call node%aval%write (u); write (u, *)
	case (V_STR)
	if (node%value_is_known) then
	write (u, "(A)") '"' // char (node%sval) // '"'
	else
	write (u, "(1x,A)") "[unknown string]"
	end if
	case default
	write (u, "(1x,A)") "[empty]"
	end select
	select case (node%type)
	case (EN_OBS1_INT, EN_OBS1_REAL)
	write (u, "(A,6x,A)", advance="no") repeat ("\| ", ind), "prt1 ="
	call prt_write (node%prt1, unit)
	case (EN_OBS2_INT, EN_OBS2_REAL)
	write (u, "(A,6x,A)", advance="no") repeat ("\| ", ind), "prt1 ="
	call prt_write (node%prt1, unit)
	write (u, "(A,6x,A)", advance="no") repeat ("\| ", ind), "prt2 ="
	call prt_write (node%prt2, unit)
	end select
	end subroutine eval_node_write

	recursive subroutine eval_node_write_rec (node, unit, indent)
	type(eval_node_t), intent(in) :: node
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: indent
	integer :: u, ind
	u = given_output_unit (unit); if (u < 0) return
	ind = 0; if (present (indent)) ind = indent
	call eval_node_write (node, unit, indent)
	select case (node%type)
	case (EN_UNARY)
	if (associated (node%arg0)) &
	call eval_node_write_rec (node%arg0, unit, ind+1)
	call eval_node_write_rec (node%arg1, unit, ind+1)
	case (EN_BINARY)
	if (associated (node%arg0)) &
	call eval_node_write_rec (node%arg0, unit, ind+1)
	call eval_node_write_rec (node%arg1, unit, ind+1)
	call eval_node_write_rec (node%arg2, unit, ind+1)
	case (EN_BLOCK)
	call eval_node_write_rec (node%arg1, unit, ind+1)
	call eval_node_write_rec (node%arg0, unit, ind+1)
	case (EN_CONDITIONAL)
	call eval_node_write_rec (node%arg0, unit, ind+1)
	call eval_node_write_rec (node%arg1, unit, ind+1)
	call eval_node_write_rec (node%arg2, unit, ind+1)
	case (EN_PRT_FUN_UNARY, EN_EVAL_FUN_UNARY, &
	EN_LOG_FUN_UNARY, EN_INT_FUN_UNARY, EN_REAL_FUN_UNARY, &
	EN_REAL_FUN_CUM)
	if (associated (node%arg0)) &
	call eval_node_write_rec (node%arg0, unit, ind+1)
	call eval_node_write_rec (node%arg1, unit, ind+1)
	case (EN_PRT_FUN_BINARY, EN_EVAL_FUN_BINARY, &
	EN_LOG_FUN_BINARY, EN_INT_FUN_BINARY, EN_REAL_FUN_BINARY)
	if (associated (node%arg0)) &
	call eval_node_write_rec (node%arg0, unit, ind+1)
	call eval_node_write_rec (node%arg1, unit, ind+1)
	call eval_node_write_rec (node%arg2, unit, ind+1)
	case (EN_RECORD_CMD)
	if (associated (node%arg1)) then
	call eval_node_write_rec (node%arg1, unit, ind+1)
	if (associated (node%arg2)) then
	call eval_node_write_rec (node%arg2, unit, ind+1)
	if (associated (node%arg3)) then
	call eval_node_write_rec (node%arg3, unit, ind+1)
	if (associated (node%arg4)) then
	call eval_node_write_rec (node%arg4, unit, ind+1)
	end if
	end if
	end if
	end if
	end select
	end subroutine eval_node_write_rec

	@ %def eval_node_write eval_node_write_rec
	@
	\subsection{Operation types}
	For the operations associated to evaluation tree nodes, we define
	abstract interfaces for all cases.

	Particles/subevents are transferred by-reference, to avoid
	unnecessary copying. Therefore, subroutines instead of functions.
	<<Eval trees: interfaces>>=
	abstract interface
	logical function unary_log (arg)
	import eval_node_t
	type(eval_node_t), intent(in) :: arg
	end function unary_log
	end interface
	abstract interface
	integer function unary_int (arg)
	import eval_node_t
	type(eval_node_t), intent(in) :: arg
	end function unary_int
	end interface
	abstract interface
	real(default) function unary_real (arg)
	import default
	import eval_node_t
	type(eval_node_t), intent(in) :: arg
	end function unary_real
	end interface
	abstract interface
	complex(default) function unary_cmplx (arg)
	import default
	import eval_node_t
	type(eval_node_t), intent(in) :: arg
	end function unary_cmplx
	end interface
	abstract interface
	subroutine unary_pdg (pdg_array, arg)
	import pdg_array_t
	import eval_node_t
	type(pdg_array_t), intent(out) :: pdg_array
	type(eval_node_t), intent(in) :: arg
	end subroutine unary_pdg
	end interface
	abstract interface
	subroutine unary_sev (subevt, arg, arg0)
	import subevt_t
	import eval_node_t
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: arg
	type(eval_node_t), intent(inout), optional :: arg0
	end subroutine unary_sev
	end interface
	abstract interface
	subroutine unary_str (string, arg)
	import string_t
	import eval_node_t
	type(string_t), intent(out) :: string
	type(eval_node_t), intent(in) :: arg
	end subroutine unary_str
	end interface
	abstract interface
	logical function unary_cut (arg1, arg0)
	import eval_node_t
	type(eval_node_t), intent(in) :: arg1
	type(eval_node_t), intent(inout) :: arg0
	end function unary_cut
	end interface
	abstract interface
	subroutine unary_evi (ival, arg1, arg0)
	import eval_node_t
	integer, intent(out) :: ival
	type(eval_node_t), intent(in) :: arg1
	type(eval_node_t), intent(inout), optional :: arg0
	end subroutine unary_evi
	end interface
	abstract interface
	subroutine unary_evr (rval, arg1, arg0)
	import eval_node_t, default
	real(default), intent(out) :: rval
	type(eval_node_t), intent(in) :: arg1
	type(eval_node_t), intent(inout), optional :: arg0
	end subroutine unary_evr
	end interface
	abstract interface
	logical function binary_log (arg1, arg2)
	import eval_node_t
	type(eval_node_t), intent(in) :: arg1, arg2
	end function binary_log
	end interface
	abstract interface
	integer function binary_int (arg1, arg2)
	import eval_node_t
	type(eval_node_t), intent(in) :: arg1, arg2
	end function binary_int
	end interface
	abstract interface
	real(default) function binary_real (arg1, arg2)
	import default
	import eval_node_t
	type(eval_node_t), intent(in) :: arg1, arg2
	end function binary_real
	end interface
	abstract interface
	complex(default) function binary_cmplx (arg1, arg2)
	import default
	import eval_node_t
	type(eval_node_t), intent(in) :: arg1, arg2
	end function binary_cmplx
	end interface
	abstract interface
	subroutine binary_pdg (pdg_array, arg1, arg2)
	import pdg_array_t
	import eval_node_t
	type(pdg_array_t), intent(out) :: pdg_array
	type(eval_node_t), intent(in) :: arg1, arg2
	end subroutine binary_pdg
	end interface
	abstract interface
	subroutine binary_sev (subevt, arg1, arg2, arg0)
	import subevt_t
	import eval_node_t
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: arg1, arg2
	type(eval_node_t), intent(inout), optional :: arg0
	end subroutine binary_sev
	end interface
	abstract interface
	subroutine binary_str (string, arg1, arg2)
	import string_t
	import eval_node_t
	type(string_t), intent(out) :: string
	type(eval_node_t), intent(in) :: arg1, arg2
	end subroutine binary_str
	end interface
	abstract interface
	logical function binary_cut (arg1, arg2, arg0)
	import eval_node_t
	type(eval_node_t), intent(in) :: arg1, arg2
	type(eval_node_t), intent(inout) :: arg0
	end function binary_cut
	end interface
	abstract interface
	subroutine binary_evi (ival, arg1, arg2, arg0)
	import eval_node_t
	integer, intent(out) :: ival
	type(eval_node_t), intent(in) :: arg1, arg2
	type(eval_node_t), intent(inout), optional :: arg0
	end subroutine binary_evi
	end interface
	abstract interface
	subroutine binary_evr (rval, arg1, arg2, arg0)
	import eval_node_t, default
	real(default), intent(out) :: rval
	type(eval_node_t), intent(in) :: arg1, arg2
	type(eval_node_t), intent(inout), optional :: arg0
	end subroutine binary_evr
	end interface
	abstract interface
	integer function cum_evi (arg1, arg0)
	import eval_node_t
	type(eval_node_t), intent(in) :: arg1
	type(eval_node_t), intent(inout) :: arg0
	end function cum_evi
	end interface
	abstract interface
	real(default) function cum_evr (arg1, arg0)
	import eval_node_t, default
	type(eval_node_t), intent(in) :: arg1
	type(eval_node_t), intent(inout) :: arg0
	end function cum_evr
	end interface

	@ The following subroutines set the procedure pointer:
	<<Eval trees: procedures>>=
	subroutine eval_node_set_op1_log (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(unary_log) :: op
	en%op1_log => op
	end subroutine eval_node_set_op1_log

	subroutine eval_node_set_op1_int (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(unary_int) :: op
	en%op1_int => op
	end subroutine eval_node_set_op1_int

	subroutine eval_node_set_op1_real (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(unary_real) :: op
	en%op1_real => op
	end subroutine eval_node_set_op1_real

	subroutine eval_node_set_op1_cmplx (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(unary_cmplx) :: op
	en%op1_cmplx => op
	end subroutine eval_node_set_op1_cmplx

	subroutine eval_node_set_op1_pdg (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(unary_pdg) :: op
	en%op1_pdg => op
	end subroutine eval_node_set_op1_pdg

	subroutine eval_node_set_op1_sev (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(unary_sev) :: op
	en%op1_sev => op
	end subroutine eval_node_set_op1_sev

	subroutine eval_node_set_op1_str (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(unary_str) :: op
	en%op1_str => op
	end subroutine eval_node_set_op1_str

	subroutine eval_node_set_op2_log (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(binary_log) :: op
	en%op2_log => op
	end subroutine eval_node_set_op2_log

	subroutine eval_node_set_op2_int (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(binary_int) :: op
	en%op2_int => op
	end subroutine eval_node_set_op2_int

	subroutine eval_node_set_op2_real (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(binary_real) :: op
	en%op2_real => op
	end subroutine eval_node_set_op2_real

	subroutine eval_node_set_op2_cmplx (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(binary_cmplx) :: op
	en%op2_cmplx => op
	end subroutine eval_node_set_op2_cmplx

	subroutine eval_node_set_op2_pdg (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(binary_pdg) :: op
	en%op2_pdg => op
	end subroutine eval_node_set_op2_pdg

	subroutine eval_node_set_op2_sev (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(binary_sev) :: op
	en%op2_sev => op
	end subroutine eval_node_set_op2_sev

	subroutine eval_node_set_op2_str (en, op)
	type(eval_node_t), intent(inout) :: en
	procedure(binary_str) :: op
	en%op2_str => op
	end subroutine eval_node_set_op2_str

	@ %def eval_node_set_operator
	@
	\subsection{Specific operators}

	Our expression syntax contains all Fortran functions that make sense.
	These functions have to be provided in a form that they can be used in
	procedures pointers, and have the abstract interfaces above.
	For some intrinsic functions, we could use specific versions provided
	by Fortran directly. However, this has two drawbacks: (i) We should
	work with the values instead of the eval-nodes as argument, which
	complicates the interface; (ii) more importantly, the [[default]] real
	type need not be equivalent to double precision. This would, at
	least, introduce system dependencies. Finally, for operators there
	are no specific versions.

	Therefore, we write wrappers for all possible functions, at the
	expense of some overhead.
	\subsubsection{Binary numerical functions}
	<<Eval trees: procedures>>=
	integer function add_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival + en2%ival
	end function add_ii
	real(default) function add_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival + en2%rval
	end function add_ir
	complex(default) function add_ic (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival + en2%cval
	end function add_ic
	real(default) function add_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval + en2%ival
	end function add_ri
	complex(default) function add_ci (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval + en2%ival
	end function add_ci
	complex(default) function add_cr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval + en2%rval
	end function add_cr
	complex(default) function add_rc (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval + en2%cval
	end function add_rc
	real(default) function add_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval + en2%rval
	end function add_rr
	complex(default) function add_cc (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval + en2%cval
	end function add_cc

	integer function sub_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival - en2%ival
	end function sub_ii
	real(default) function sub_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival - en2%rval
	end function sub_ir
	real(default) function sub_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval - en2%ival
	end function sub_ri
	complex(default) function sub_ic (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival - en2%cval
	end function sub_ic
	complex(default) function sub_ci (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval - en2%ival
	end function sub_ci
	complex(default) function sub_cr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval - en2%rval
	end function sub_cr
	complex(default) function sub_rc (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval - en2%cval
	end function sub_rc
	real(default) function sub_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval - en2%rval
	end function sub_rr
	complex(default) function sub_cc (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval - en2%cval
	end function sub_cc

	integer function mul_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival * en2%ival
	end function mul_ii
	real(default) function mul_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival * en2%rval
	end function mul_ir
	real(default) function mul_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval * en2%ival
	end function mul_ri
	complex(default) function mul_ic (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival * en2%cval
	end function mul_ic
	complex(default) function mul_ci (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval * en2%ival
	end function mul_ci
	complex(default) function mul_rc (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval * en2%cval
	end function mul_rc
	complex(default) function mul_cr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval * en2%rval
	end function mul_cr
	real(default) function mul_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval * en2%rval
	end function mul_rr
	complex(default) function mul_cc (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval * en2%cval
	end function mul_cc

	integer function div_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (en2%ival == 0) then
	if (en1%ival >= 0) then
	call msg_warning ("division by zero: " // int2char (en1%ival) // &
	" / 0 ; result set to 0")
	else
	call msg_warning ("division by zero: (" // int2char (en1%ival) // &
	") / 0 ; result set to 0")
	end if
	y = 0
	return
	end if
	y = en1%ival / en2%ival
	end function div_ii
	real(default) function div_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival / en2%rval
	end function div_ir
	real(default) function div_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval / en2%ival
	end function div_ri
	complex(default) function div_ic (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival / en2%cval
	end function div_ic
	complex(default) function div_ci (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval / en2%ival
	end function div_ci
	complex(default) function div_rc (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval / en2%cval
	end function div_rc
	complex(default) function div_cr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval / en2%rval
	end function div_cr
	real(default) function div_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval / en2%rval
	end function div_rr
	complex(default) function div_cc (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval / en2%cval
	end function div_cc

	integer function pow_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	integer :: a, b
	real(default) :: rres
	a = en1%ival
	b = en2%ival
	if ((a == 0) .and. (b < 0)) then
	call msg_warning ("division by zero: " // int2char (a) // &
	" ^ (" // int2char (b) // ") ; result set to 0")
	y = 0
	return
	end if
	rres = real(a, default) ** b
	y = rres
	if (real(y, default) /= rres) then
	if (b < 0) then
	call msg_warning ("result of all-integer operation " // &
	int2char (a) // " ^ (" // int2char (b) // &
	") has been trucated to "// int2char (y), &
	[ var_str ("Chances are that you want to use " // &
	"reals instead of integers at this point.") ])
	else
	call msg_warning ("integer overflow in " // int2char (a) // &
	" ^ " // int2char (b) // " ; result is " // int2char (y), &
	[ var_str ("Using reals instead of integers might help.")])
	end if
	end if
	end function pow_ii
	real(default) function pow_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval ** en2%ival
	end function pow_ri
	complex(default) function pow_ci (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval ** en2%ival
	end function pow_ci
	real(default) function pow_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival ** en2%rval
	end function pow_ir
	real(default) function pow_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval ** en2%rval
	end function pow_rr
	complex(default) function pow_cr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval ** en2%rval
	end function pow_cr
	complex(default) function pow_ic (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival ** en2%cval
	end function pow_ic
	complex(default) function pow_rc (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval ** en2%cval
	end function pow_rc
	complex(default) function pow_cc (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%cval ** en2%cval
	end function pow_cc

	integer function max_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = max (en1%ival, en2%ival)
	end function max_ii
	real(default) function max_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = max (real (en1%ival, default), en2%rval)
	end function max_ir
	real(default) function max_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = max (en1%rval, real (en2%ival, default))
	end function max_ri
	real(default) function max_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = max (en1%rval, en2%rval)
	end function max_rr
	integer function min_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = min (en1%ival, en2%ival)
	end function min_ii
	real(default) function min_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = min (real (en1%ival, default), en2%rval)
	end function min_ir
	real(default) function min_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = min (en1%rval, real (en2%ival, default))
	end function min_ri
	real(default) function min_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = min (en1%rval, en2%rval)
	end function min_rr

	integer function mod_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = mod (en1%ival, en2%ival)
	end function mod_ii
	real(default) function mod_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = mod (real (en1%ival, default), en2%rval)
	end function mod_ir
	real(default) function mod_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = mod (en1%rval, real (en2%ival, default))
	end function mod_ri
	real(default) function mod_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = mod (en1%rval, en2%rval)
	end function mod_rr
	integer function modulo_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = modulo (en1%ival, en2%ival)
	end function modulo_ii
	real(default) function modulo_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = modulo (real (en1%ival, default), en2%rval)
	end function modulo_ir
	real(default) function modulo_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = modulo (en1%rval, real (en2%ival, default))
	end function modulo_ri
	real(default) function modulo_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = modulo (en1%rval, en2%rval)
	end function modulo_rr

	@
	\subsubsection{Unary numeric functions}
	<<Eval trees: procedures>>=
	real(default) function real_i (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = en%ival
	end function real_i
	real(default) function real_c (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = en%cval
	end function real_c
	integer function int_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = en%rval
	end function int_r
	complex(default) function cmplx_i (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = en%ival
	end function cmplx_i
	integer function int_c (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = en%cval
	end function int_c
	complex(default) function cmplx_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = en%rval
	end function cmplx_r
	integer function nint_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = nint (en%rval)
	end function nint_r
	integer function floor_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = floor (en%rval)
	end function floor_r
	integer function ceiling_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = ceiling (en%rval)
	end function ceiling_r

	integer function neg_i (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = - en%ival
	end function neg_i
	real(default) function neg_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = - en%rval
	end function neg_r
	complex(default) function neg_c (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = - en%cval
	end function neg_c
	integer function abs_i (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = abs (en%ival)
	end function abs_i
	real(default) function abs_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = abs (en%rval)
	end function abs_r
	real(default) function abs_c (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = abs (en%cval)
	end function abs_c
	integer function conjg_i (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = en%ival
	end function conjg_i
	real(default) function conjg_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = en%rval
	end function conjg_r
	complex(default) function conjg_c (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = conjg (en%cval)
	end function conjg_c
	integer function sgn_i (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = sign (1, en%ival)
	end function sgn_i
	real(default) function sgn_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = sign (1._default, en%rval)
	end function sgn_r

	real(default) function sqrt_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = sqrt (en%rval)
	end function sqrt_r
	real(default) function exp_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = exp (en%rval)
	end function exp_r
	real(default) function log_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = log (en%rval)
	end function log_r
	real(default) function log10_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = log10 (en%rval)
	end function log10_r

	complex(default) function sqrt_c (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = sqrt (en%cval)
	end function sqrt_c
	complex(default) function exp_c (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = exp (en%cval)
	end function exp_c
	complex(default) function log_c (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = log (en%cval)
	end function log_c

	real(default) function sin_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = sin (en%rval)
	end function sin_r
	real(default) function cos_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = cos (en%rval)
	end function cos_r
	real(default) function tan_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = tan (en%rval)
	end function tan_r
	real(default) function asin_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = asin (en%rval)
	end function asin_r
	real(default) function acos_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = acos (en%rval)
	end function acos_r
	real(default) function atan_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = atan (en%rval)
	end function atan_r

	complex(default) function sin_c (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = sin (en%cval)
	end function sin_c
	complex(default) function cos_c (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = cos (en%cval)
	end function cos_c

	real(default) function sinh_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = sinh (en%rval)
	end function sinh_r
	real(default) function cosh_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = cosh (en%rval)
	end function cosh_r
	real(default) function tanh_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = tanh (en%rval)
	end function tanh_r
	real(default) function asinh_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = asinh (en%rval)
	end function asinh_r
	real(default) function acosh_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = acosh (en%rval)
	end function acosh_r
	real(default) function atanh_r (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = atanh (en%rval)
	end function atanh_r

	@
	\subsubsection{Binary logical functions}
	Logical expressions:
	<<Eval trees: procedures>>=
	logical function ignore_first_ll (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en2%lval
	end function ignore_first_ll
	logical function or_ll (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%lval .or. en2%lval
	end function or_ll
	logical function and_ll (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%lval .and. en2%lval
	end function and_ll

	@ Comparisons:
	<<Eval trees: procedures>>=
	logical function comp_lt_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival < en2%ival
	end function comp_lt_ii
	logical function comp_lt_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival < en2%rval
	end function comp_lt_ir
	logical function comp_lt_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval < en2%ival
	end function comp_lt_ri
	logical function comp_lt_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval < en2%rval
	end function comp_lt_rr

	logical function comp_gt_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival > en2%ival
	end function comp_gt_ii
	logical function comp_gt_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival > en2%rval
	end function comp_gt_ir
	logical function comp_gt_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval > en2%ival
	end function comp_gt_ri
	logical function comp_gt_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval > en2%rval
	end function comp_gt_rr

	logical function comp_le_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival <= en2%ival
	end function comp_le_ii
	logical function comp_le_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival <= en2%rval
	end function comp_le_ir
	logical function comp_le_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval <= en2%ival
	end function comp_le_ri
	logical function comp_le_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval <= en2%rval
	end function comp_le_rr

	logical function comp_ge_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival >= en2%ival
	end function comp_ge_ii
	logical function comp_ge_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival >= en2%rval
	end function comp_ge_ir
	logical function comp_ge_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval >= en2%ival
	end function comp_ge_ri
	logical function comp_ge_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval >= en2%rval
	end function comp_ge_rr

	logical function comp_eq_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival == en2%ival
	end function comp_eq_ii
	logical function comp_eq_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival == en2%rval
	end function comp_eq_ir
	logical function comp_eq_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval == en2%ival
	end function comp_eq_ri
	logical function comp_eq_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval == en2%rval
	end function comp_eq_rr
	logical function comp_eq_ss (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%sval == en2%sval
	end function comp_eq_ss

	logical function comp_ne_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival /= en2%ival
	end function comp_ne_ii
	logical function comp_ne_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%ival /= en2%rval
	end function comp_ne_ir
	logical function comp_ne_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval /= en2%ival
	end function comp_ne_ri
	logical function comp_ne_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%rval /= en2%rval
	end function comp_ne_rr
	logical function comp_ne_ss (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	y = en1%sval /= en2%sval
	end function comp_ne_ss

	@ Comparisons with tolerance:
	<<Eval trees: procedures>>=
	logical function comp_se_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = abs (en1%ival - en2%ival) <= en1%tolerance
	else
	y = en1%ival == en2%ival
	end if
	end function comp_se_ii
	logical function comp_se_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = abs (en1%rval - en2%ival) <= en1%tolerance
	else
	y = en1%rval == en2%ival
	end if
	end function comp_se_ri
	logical function comp_se_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = abs (en1%ival - en2%rval) <= en1%tolerance
	else
	y = en1%ival == en2%rval
	end if
	end function comp_se_ir
	logical function comp_se_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = abs (en1%rval - en2%rval) <= en1%tolerance
	else
	y = en1%rval == en2%rval
	end if
	end function comp_se_rr
	logical function comp_ns_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = abs (en1%ival - en2%ival) > en1%tolerance
	else
	y = en1%ival /= en2%ival
	end if
	end function comp_ns_ii
	logical function comp_ns_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = abs (en1%rval - en2%ival) > en1%tolerance
	else
	y = en1%rval /= en2%ival
	end if
	end function comp_ns_ri
	logical function comp_ns_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = abs (en1%ival - en2%rval) > en1%tolerance
	else
	y = en1%ival /= en2%rval
	end if
	end function comp_ns_ir
	logical function comp_ns_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = abs (en1%rval - en2%rval) > en1%tolerance
	else
	y = en1%rval /= en2%rval
	end if
	end function comp_ns_rr

	logical function comp_ls_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%ival <= en2%ival + en1%tolerance
	else
	y = en1%ival <= en2%ival
	end if
	end function comp_ls_ii
	logical function comp_ls_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%rval <= en2%ival + en1%tolerance
	else
	y = en1%rval <= en2%ival
	end if
	end function comp_ls_ri
	logical function comp_ls_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%ival <= en2%rval + en1%tolerance
	else
	y = en1%ival <= en2%rval
	end if
	end function comp_ls_ir
	logical function comp_ls_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%rval <= en2%rval + en1%tolerance
	else
	y = en1%rval <= en2%rval
	end if
	end function comp_ls_rr

	logical function comp_ll_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%ival < en2%ival - en1%tolerance
	else
	y = en1%ival < en2%ival
	end if
	end function comp_ll_ii
	logical function comp_ll_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%rval < en2%ival - en1%tolerance
	else
	y = en1%rval < en2%ival
	end if
	end function comp_ll_ri
	logical function comp_ll_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%ival < en2%rval - en1%tolerance
	else
	y = en1%ival < en2%rval
	end if
	end function comp_ll_ir
	logical function comp_ll_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%rval < en2%rval - en1%tolerance
	else
	y = en1%rval < en2%rval
	end if
	end function comp_ll_rr

	logical function comp_gs_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%ival >= en2%ival - en1%tolerance
	else
	y = en1%ival >= en2%ival
	end if
	end function comp_gs_ii
	logical function comp_gs_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%rval >= en2%ival - en1%tolerance
	else
	y = en1%rval >= en2%ival
	end if
	end function comp_gs_ri
	logical function comp_gs_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%ival >= en2%rval - en1%tolerance
	else
	y = en1%ival >= en2%rval
	end if
	end function comp_gs_ir
	logical function comp_gs_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%rval >= en2%rval - en1%tolerance
	else
	y = en1%rval >= en2%rval
	end if
	end function comp_gs_rr

	logical function comp_gg_ii (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%ival > en2%ival + en1%tolerance
	else
	y = en1%ival > en2%ival
	end if
	end function comp_gg_ii
	logical function comp_gg_ri (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%rval > en2%ival + en1%tolerance
	else
	y = en1%rval > en2%ival
	end if
	end function comp_gg_ri
	logical function comp_gg_ir (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%ival > en2%rval + en1%tolerance
	else
	y = en1%ival > en2%rval
	end if
	end function comp_gg_ir
	logical function comp_gg_rr (en1, en2) result (y)
	type(eval_node_t), intent(in) :: en1, en2
	if (associated (en1%tolerance)) then
	y = en1%rval > en2%rval + en1%tolerance
	else
	y = en1%rval > en2%rval
	end if
	end function comp_gg_rr

	@
	\subsubsection{Unary logical functions}
	<<Eval trees: procedures>>=
	logical function not_l (en) result (y)
	type(eval_node_t), intent(in) :: en
	y = .not. en%lval
	end function not_l

	@
	\subsubsection{Unary PDG-array functions}
	Make a PDG-array object from an integer.
	<<Eval trees: procedures>>=
	subroutine pdg_i (pdg_array, en)
	type(pdg_array_t), intent(out) :: pdg_array
	type(eval_node_t), intent(in) :: en
	pdg_array = en%ival
	end subroutine pdg_i

	@
	\subsubsection{Binary PDG-array functions}
	Concatenate two PDG-array objects.
	<<Eval trees: procedures>>=
	subroutine concat_cc (pdg_array, en1, en2)
	type(pdg_array_t), intent(out) :: pdg_array
	type(eval_node_t), intent(in) :: en1, en2
	pdg_array = en1%aval // en2%aval
	end subroutine concat_cc

	@
	\subsubsection{Unary particle-list functions}
	Combine all particles of the first argument. If [[en0]] is present,
	create a mask which is true only for those particles that pass the
	test.
	<<Eval trees: procedures>>=
	subroutine collect_p (subevt, en1, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:), allocatable :: mask1
	integer :: n, i
	n = en1%pval%get_length ()
	allocate (mask1 (n))
	if (present (en0)) then
	do i = 1, n
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	mask1(i) = en0%lval
	end do
	else
	mask1 = .true.
	end if
	call subevt_collect (subevt, en1%pval, mask1)
	end subroutine collect_p

	@ %def collect_p
	@ Cluster the particles of the first argument. If [[en0]] is present,
	create a mask which is true only for those particles that pass the
	test.
	<<Eval trees: procedures>>=
	subroutine cluster_p (subevt, en1, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:), allocatable :: mask1
	integer :: n, i
	!!! Should not be initialized for every event
	type(jet_definition_t) :: jet_def
	logical :: keep_jets, exclusive
	call jet_def%init (en1%jet_algorithm, en1%jet_r, en1%jet_p, en1%jet_ycut)
	n = en1%pval%get_length ()
	allocate (mask1 (n))
	if (present (en0)) then
	do i = 1, n
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	mask1(i) = en0%lval
	end do
	else
	mask1 = .true.
	end if
	if (associated (en1%var_list)) then
	keep_jets = en1%var_list%get_lval (var_str("?keep_flavors_when_clustering"))
	else
	keep_jets = .false.
	end if
	exclusive = .false.
	select case (en1%jet_algorithm)
	case (ee_kt_algorithm)
	exclusive = .true.
	case (ee_genkt_algorithm)
	if (en1%jet_r > Pi) exclusive = .true.
	end select
	call subevt_cluster (subevt, en1%pval, en1%jet_dcut, mask1, &
	jet_def, keep_jets, exclusive)
	call jet_def%final ()
	end subroutine cluster_p

	@ %def cluster_p
	@ Recombine photons with other particles (usually charged leptons and
	maybe quarks) given in the same subevent. If [[en0]] is present,
	create a mask which is true only for those particles that pass the test.
	<<Eval trees: procedures>>=
	subroutine photon_recombination_p (subevt, en1, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:), allocatable :: mask1
	type(prt_t), dimension(:), allocatable :: prt
	integer :: n, i
	real(default) :: reco_r0
	logical :: keep_flv
	reco_r0 = en1%photon_rec_r0
	n = en1%pval%get_length ()
	allocate (prt (n))
	do i = 1, n
	prt(i) = en1%pval%get_prt (i)
	if (.not. prt_is_recombinable (prt (i))) then
	call msg_fatal ("Only charged leptons, quarks, and " //&
	"photons can be included in photon recombination.")
	end if
	end do
	if (count (prt_is_photon (prt)) > 1) &
	call msg_fatal ("Photon recombination is supported " // &
	"only for single photons.")
	allocate (mask1 (n))
	if (present (en0)) then
	do i = 1, n
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	mask1(i) = en0%lval
	end do
	else
	mask1 = .true.
	end if
	if (associated (en1%var_list)) then
	keep_flv = en1%var_list%get_lval &
	(var_str("?keep_flavors_when_recombining"))
	else
	keep_flv = .false.
	end if
	call subevt_recombine &
	(subevt, en1%pval, mask1, reco_r0, keep_flv)
	end subroutine photon_recombination_p

	@ %def photon_recombination_p
	@ Select all particles of the first argument. If [[en0]] is present,
	create a mask which is true only for those particles that pass the
	test.
	<<Eval trees: procedures>>=
	subroutine select_p (subevt, en1, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:), allocatable :: mask1
	integer :: n, i
	n = en1%pval%get_length ()
	allocate (mask1 (n))
	if (present (en0)) then
	do i = 1, n
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	mask1(i) = en0%lval
	end do
	else
	mask1 = .true.
	end if
	call subevt_select (subevt, en1%pval, mask1)
	end subroutine select_p

	@ %def select_p
	[[select_b_jet_p]], [[select_non_b_jet_p]], [[select_c_jet_p]], and
	[[select_light_jet_p]] are special selection function acting on a
	subevent of combined particles (jets) and result in a list of $b$
	jets, non-$b$ jets (i.e. $c$ and light jets), $c$ jets, and light
	jets, respectively.
	<<Eval trees: procedures>>=
	subroutine select_b_jet_p (subevt, en1, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:), allocatable :: mask1
	integer :: n, i
	n = en1%pval%get_length ()
	allocate (mask1 (n))
	do i = 1, n
	mask1(i) = prt_is_b_jet (en1%pval%get_prt (i))
	if (present (en0)) then
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	mask1(i) = en0%lval .and. mask1(i)
	end if
	end do
	call subevt_select (subevt, en1%pval, mask1)
	end subroutine select_b_jet_p

	@ %def select_b_jet_p
	<<Eval trees: procedures>>=
	subroutine select_non_b_jet_p (subevt, en1, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:), allocatable :: mask1
	integer :: n, i
	n = en1%pval%get_length ()
	allocate (mask1 (n))
	do i = 1, n
	mask1(i) = .not. prt_is_b_jet (en1%pval%get_prt (i))
	if (present (en0)) then
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	mask1(i) = en0%lval .and. mask1(i)
	end if
	end do
	call subevt_select (subevt, en1%pval, mask1)
	end subroutine select_non_b_jet_p

	@ %def select_non_b_jet_p
	<<Eval trees: procedures>>=
	subroutine select_c_jet_p (subevt, en1, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:), allocatable :: mask1
	integer :: n, i
	n = en1%pval%get_length ()
	allocate (mask1 (n))
	do i = 1, n
	mask1(i) = .not. prt_is_b_jet (en1%pval%get_prt (i)) &
	.and. prt_is_c_jet (en1%pval%get_prt (i))
	if (present (en0)) then
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	mask1(i) = en0%lval .and. mask1(i)
	end if
	end do
	call subevt_select (subevt, en1%pval, mask1)
	end subroutine select_c_jet_p

	@ %def select_c_jet_p
	<<Eval trees: procedures>>=
	subroutine select_light_jet_p (subevt, en1, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:), allocatable :: mask1
	integer :: n, i
	n = en1%pval%get_length ()
	allocate (mask1 (n))
	do i = 1, n
	mask1(i) = .not. prt_is_b_jet (en1%pval%get_prt (i)) &
	.and. .not. prt_is_c_jet (en1%pval%get_prt (i))
	if (present (en0)) then
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	mask1(i) = en0%lval .and. mask1(i)
	end if
	end do
	call subevt_select (subevt, en1%pval, mask1)
	end subroutine select_light_jet_p

	@ %def select_light_jet_p
	@ Extract the particle with index given by [[en0]] from the argument
	list. Negative indices count from the end. If [[en0]] is absent,
	extract the first particle. The result is a list with a single entry,
	or no entries if the original list was empty or if the index is out of
	range.

	This function has no counterpart with two arguments.
	<<Eval trees: procedures>>=
	subroutine extract_p (subevt, en1, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout), optional :: en0
	integer :: index
	if (present (en0)) then
	call eval_node_evaluate (en0)
	select case (en0%result_type)
	case (V_INT); index = en0%ival
	case default
	call eval_node_write (en0)
	call msg_fatal (" Index parameter of 'extract' must be integer.")
	end select
	else
	index = 1
	end if
	call subevt_extract (subevt, en1%pval, index)
	end subroutine extract_p

	@ %def extract_p
	@ Sort the subevent according to the result of evaluating
	[[en0]]. If [[en0]] is absent, sort by default method (PDG code,
	particles before antiparticles).
	<<Eval trees: procedures>>=
	subroutine sort_p (subevt, en1, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout), optional :: en0
	integer, dimension(:), allocatable :: ival
	real(default), dimension(:), allocatable :: rval
	integer :: i, n
	n = en1%pval%get_length ()
	if (present (en0)) then
	select case (en0%result_type)
	case (V_INT); allocate (ival (n))
	case (V_REAL); allocate (rval (n))
	end select
	do i = 1, n
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	select case (en0%result_type)
	case (V_INT); ival(i) = en0%ival
	case (V_REAL); rval(i) = en0%rval
	end select
	end do
	select case (en0%result_type)
	case (V_INT); call subevt_sort (subevt, en1%pval, ival)
	case (V_REAL); call subevt_sort (subevt, en1%pval, rval)
	end select
	else
	call subevt_sort (subevt, en1%pval)
	end if
	end subroutine sort_p

	@ %def sort_p
	@ The following functions return a logical value. [[all]] evaluates
	to true if the condition [[en0]] is true for all elements of the
	subevent. [[any]] and [[no]] are analogous.
	<<Eval trees: procedures>>=
	function all_p (en1, en0) result (lval)
	logical :: lval
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout) :: en0
	integer :: i, n
	n = en1%pval%get_length ()
	lval = .true.
	do i = 1, n
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	lval = en0%lval
	if (.not. lval) exit
	end do
	end function all_p

	function any_p (en1, en0) result (lval)
	logical :: lval
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout) :: en0
	integer :: i, n
	n = en1%pval%get_length ()
	lval = .false.
	do i = 1, n
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	lval = en0%lval
	if (lval) exit
	end do
	end function any_p

	function no_p (en1, en0) result (lval)
	logical :: lval
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout) :: en0
	integer :: i, n
	n = en1%pval%get_length ()
	lval = .true.
	do i = 1, n
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	lval = .not. en0%lval
	if (lval) exit
	end do
	end function no_p

	@ %def all_p any_p no_p
	@ The following function returns an integer value, namely the number
	of particles for which the condition is true. If there is no
	condition, it returns simply the length of the subevent.
	<<Eval trees: procedures>>=
	subroutine count_a (ival, en1, en0)
	integer, intent(out) :: ival
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout), optional :: en0
	integer :: i, n, count
	n = en1%pval%get_length ()
	if (present (en0)) then
	count = 0
	do i = 1, n
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	if (en0%lval) count = count + 1
	end do
	ival = count
	else
	ival = n
	end if
	end subroutine count_a

	@ %def count_a
	@ The following functions return either an integer or a real
	value, namely the sum or the product of the values of the
	corresponding expression.
	<<Eval trees: procedures>>=
	function sum_a (en1, en0) result (rval)
	real(default) :: rval
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout) :: en0
	integer :: i, n
	n = en1%pval%get_length ()
	rval = 0._default
	do i = 1, n
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	rval = rval + en0%rval
	end do
	end function sum_a

	function prod_a (en1, en0) result (rval)
	real(default) :: rval
	type(eval_node_t), intent(in) :: en1
	type(eval_node_t), intent(inout) :: en0
	integer :: i, n
	n = en1%pval%get_length ()
	rval = 1._default
	do i = 1, n
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	call eval_node_evaluate (en0)
	rval = rval * en0%rval
	end do
	end function prod_a

	@ %def sum_a prod_a
	\subsubsection{Binary particle-list functions}
	This joins two subevents, stored in the evaluation nodes [[en1]]
	and [[en2]]. If [[en0]] is also present, it amounts to a logical test
	returning true or false for every pair of particles. A particle of
	the second list gets a mask entry only if it passes the test for all
	particles of the first list.
	<<Eval trees: procedures>>=
	subroutine join_pp (subevt, en1, en2, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:), allocatable :: mask2
	integer :: i, j, n1, n2
	n1 = en1%pval%get_length ()
	n2 = en2%pval%get_length ()
	allocate (mask2 (n2))
	mask2 = .true.
	if (present (en0)) then
	do i = 1, n1
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	do j = 1, n2
	en0%prt2 = en2%pval%get_prt (j)
	call eval_node_evaluate (en0)
	mask2(j) = mask2(j) .and. en0%lval
	end do
	end do
	end if
	call subevt_join (subevt, en1%pval, en2%pval, mask2)
	end subroutine join_pp

	@ %def join_pp
	@ Combine two subevents, i.e., make a list of composite particles
	built from all possible particle pairs from the two lists. If [[en0]]
	is present, create a mask which is true only for those pairs that pass
	the test.
	<<Eval trees: procedures>>=
	subroutine combine_pp (subevt, en1, en2, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:,:), allocatable :: mask12
	integer :: i, j, n1, n2
	n1 = en1%pval%get_length ()
	n2 = en2%pval%get_length ()
	if (present (en0)) then
	allocate (mask12 (n1, n2))
	do i = 1, n1
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	do j = 1, n2
	en0%prt2 = en2%pval%get_prt (j)
	call eval_node_evaluate (en0)
	mask12(i,j) = en0%lval
	end do
	end do
	call subevt_combine (subevt, en1%pval, en2%pval, mask12)
	else
	call subevt_combine (subevt, en1%pval, en2%pval)
	end if
	end subroutine combine_pp

	@ %def combine_pp
	@ Combine all particles of the first argument. If [[en0]] is present,
	create a mask which is true only for those particles that pass the
	test w.r.t. all particles in the second argument. If [[en0]] is
	absent, the second argument is ignored.
	<<Eval trees: procedures>>=
	subroutine collect_pp (subevt, en1, en2, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:), allocatable :: mask1
	integer :: i, j, n1, n2
	n1 = en1%pval%get_length ()
	n2 = en2%pval%get_length ()
	allocate (mask1 (n1))
	mask1 = .true.
	if (present (en0)) then
	do i = 1, n1
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	do j = 1, n2
	en0%prt2 = en2%pval%get_prt (j)
	call eval_node_evaluate (en0)
	mask1(i) = mask1(i) .and. en0%lval
	end do
	end do
	end if
	call subevt_collect (subevt, en1%pval, mask1)
	end subroutine collect_pp

	@ %def collect_pp
	@ Select all particles of the first argument. If [[en0]] is present,
	create a mask which is true only for those particles that pass the
	test w.r.t. all particles in the second argument. If [[en0]] is
	absent, the second argument is ignored, and the first argument is
	transferred unchanged. (This case is not very useful, of course.)
	<<Eval trees: procedures>>=
	subroutine select_pp (subevt, en1, en2, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout), optional :: en0
	logical, dimension(:), allocatable :: mask1
	integer :: i, j, n1, n2
	n1 = en1%pval%get_length ()
	n2 = en2%pval%get_length ()
	allocate (mask1 (n1))
	mask1 = .true.
	if (present (en0)) then
	do i = 1, n1
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	do j = 1, n2
	en0%prt2 = en2%pval%get_prt (j)
	call eval_node_evaluate (en0)
	mask1(i) = mask1(i) .and. en0%lval
	end do
	end do
	end if
	call subevt_select (subevt, en1%pval, mask1)
	end subroutine select_pp

	@ %def select_pp
	@ Sort the first subevent according to the result of evaluating
	[[en0]]. From the second subevent, only the first element is
	taken as reference. If [[en0]] is absent, we sort by default method
	(PDG code, particles before antiparticles).
	<<Eval trees: procedures>>=
	subroutine sort_pp (subevt, en1, en2, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout), optional :: en0
	integer, dimension(:), allocatable :: ival
	real(default), dimension(:), allocatable :: rval
	integer :: i, n1
	n1 = en1%pval%get_length ()
	if (present (en0)) then
	select case (en0%result_type)
	case (V_INT); allocate (ival (n1))
	case (V_REAL); allocate (rval (n1))
	end select
	do i = 1, n1
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	en0%prt2 = en2%pval%get_prt (1)
	call eval_node_evaluate (en0)
	select case (en0%result_type)
	case (V_INT); ival(i) = en0%ival
	case (V_REAL); rval(i) = en0%rval
	end select
	end do
	select case (en0%result_type)
	case (V_INT); call subevt_sort (subevt, en1%pval, ival)
	case (V_REAL); call subevt_sort (subevt, en1%pval, rval)
	end select
	else
	call subevt_sort (subevt, en1%pval)
	end if
	end subroutine sort_pp

	@ %def sort_pp
	@ The following functions return a logical value. [[all]] evaluates
	to true if the condition [[en0]] is true for all valid element pairs
	of both subevents. Invalid pairs (with common [[src]] entry) are
	ignored.

	[[any]] and [[no]] are analogous.
	<<Eval trees: procedures>>=
	function all_pp (en1, en2, en0) result (lval)
	logical :: lval
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout) :: en0
	integer :: i, j, n1, n2
	n1 = en1%pval%get_length ()
	n2 = en2%pval%get_length ()
	lval = .true.
	LOOP1: do i = 1, n1
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	do j = 1, n2
	en0%prt2 = en2%pval%get_prt (j)
	if (are_disjoint (en0%prt1, en0%prt2)) then
	call eval_node_evaluate (en0)
	lval = en0%lval
	if (.not. lval) exit LOOP1
	end if
	end do
	end do LOOP1
	end function all_pp

	function any_pp (en1, en2, en0) result (lval)
	logical :: lval
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout) :: en0
	integer :: i, j, n1, n2
	n1 = en1%pval%get_length ()
	n2 = en2%pval%get_length ()
	lval = .false.
	LOOP1: do i = 1, n1
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	do j = 1, n2
	en0%prt2 = en2%pval%get_prt (j)
	if (are_disjoint (en0%prt1, en0%prt2)) then
	call eval_node_evaluate (en0)
	lval = en0%lval
	if (lval) exit LOOP1
	end if
	end do
	end do LOOP1
	end function any_pp

	function no_pp (en1, en2, en0) result (lval)
	logical :: lval
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout) :: en0
	integer :: i, j, n1, n2
	n1 = en1%pval%get_length ()
	n2 = en2%pval%get_length ()
	lval = .true.
	LOOP1: do i = 1, n1
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	do j = 1, n2
	en0%prt2 = en2%pval%get_prt (j)
	if (are_disjoint (en0%prt1, en0%prt2)) then
	call eval_node_evaluate (en0)
	lval = .not. en0%lval
	if (lval) exit LOOP1
	end if
	end do
	end do LOOP1
	end function no_pp

	@ %def all_pp any_pp no_pp
	The conditional restriction encoded in the [[eval_node_t]] [[en_0]] is
	applied only to the photons from [[en1]], not to the objects being
	isolated from in [[en2]].
	<<Eval trees: procedures>>=
	function photon_isolation_pp (en1, en2, en0) result (lval)
	logical :: lval
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout) :: en0
	type(prt_t) :: prt
	type(prt_t), dimension(:), allocatable :: prt_gam0, prt_lep
	type(vector4_t), dimension(:), allocatable :: &
	p_gam0, p_lep0, p_lep, p_par
	integer :: i, j, n1, n2, n_par, n_lep, n_gam, n_delta
	real(default), dimension(:), allocatable :: delta_r, et_sum
	integer, dimension(:), allocatable :: index
	real(default) :: eps, iso_n, r0, pt_gam
	logical, dimension(:,:), allocatable :: photon_mask
	n1 = en1%pval%get_length ()
	n2 = en2%pval%get_length ()
	allocate (p_gam0 (n1), prt_gam0 (n1))
	eps = en1%photon_iso_eps
	iso_n = en1%photon_iso_n
	r0 = en1%photon_iso_r0
	lval = .true.
	do i = 1, n1
	en0%index = i
	prt = en1%pval%get_prt (i)
	prt_gam0(i) = prt
	if (.not. prt_is_photon (prt_gam0(i))) &
	call msg_fatal ("Photon isolation can only " // &
	"be applied to photons.")
	p_gam0(i) = prt_get_momentum (prt_gam0(i))
	en0%prt1 = prt
	call eval_node_evaluate (en0)
	lval = en0%lval
	if (.not. lval) return
	end do
	if (n1 == 0) then
	call msg_fatal ("Photon isolation applied on empty photon sample.")
	end if
	n_par = 0
	n_lep = 0
	n_gam = 0
	do i = 1, n2
	prt = en2%pval%get_prt (i)
	if (prt_is_parton (prt) .or. prt_is_clustered (prt)) then
	n_par = n_par + 1
	end if
	if (prt_is_lepton (prt)) then
	n_lep = n_lep + 1
	end if
	if (prt_is_photon (prt)) then
	n_gam = n_gam + 1
	end if
	end do
	if (n_lep > 0 .and. n_gam == 0) then
	call msg_fatal ("Photon isolation from EM energy: photons " // &
	"have to be included.")
	end if
	if (n_lep > 0 .and. n_gam /= n1) then
	call msg_fatal ("Photon isolation: photon samples do not match.")
	end if
	allocate (p_par (n_par))
	allocate (p_lep0 (n_gam+n_lep), prt_lep(n_gam+n_lep))
	n_par = 0
	n_lep = 0
	do i = 1, n2
	prt = en2%pval%get_prt (i)
	if (prt_is_parton (prt) .or. prt_is_clustered (prt)) then
	n_par = n_par + 1
	p_par(n_par) = prt_get_momentum (prt)
	end if
	if (prt_is_lepton (prt) .or. prt_is_photon(prt)) then
	n_lep = n_lep + 1
	prt_lep(n_lep) = prt
	p_lep0(n_lep) = prt_get_momentum (prt_lep(n_lep))
	end if
	end do
	if (n_par > 0) then
	allocate (delta_r (n_par), index (n_par))
	HADRON_ISOLATION: do i = 1, n1
	pt_gam = transverse_part (p_gam0(i))
	delta_r(1:n_par) = sort (eta_phi_distance (p_gam0(i), p_par(1:n_par)))
	index(1:n_par) = order (eta_phi_distance (p_gam0(i), p_par(1:n_par)))
	n_delta = count (delta_r < r0)
	allocate (et_sum(n_delta))
	do j = 1, n_delta
	et_sum(j) = sum (transverse_part (p_par (index (1:j))))
	if (.not. et_sum(j) <= &
	iso_chi_gamma (delta_r(j), r0, iso_n, eps, pt_gam)) then
	lval = .false.
	return
	end if
	end do
	deallocate (et_sum)
	end do HADRON_ISOLATION
	deallocate (delta_r)
	deallocate (index)
	end if
	if (n_lep > 0) then
	allocate (photon_mask(n1,n_lep))
	do i = 1, n1
	photon_mask(i,:) = .not. (prt_gam0(i) .match. prt_lep(:))
	end do
	allocate (delta_r (n_lep-1), index (n_lep-1), p_lep(n_lep-1))
	EM_ISOLATION: do i = 1, n1
	pt_gam = transverse_part (p_gam0(i))
	p_lep = pack (p_lep0, photon_mask(i,:))
	delta_r(1:n_lep-1) = sort (eta_phi_distance (p_gam0(i), p_lep(1:n_lep-1)))
	index(1:n_lep-1) = order (eta_phi_distance (p_gam0(i), p_lep(1:n_lep-1)))
	n_delta = count (delta_r < r0)
	allocate (et_sum(n_delta))
	do j = 1, n_delta
	et_sum(j) = sum (transverse_part (p_lep (index(1:j))))
	if (.not. et_sum(j) <= &
	iso_chi_gamma (delta_r(j), r0, iso_n, eps, pt_gam)) then
	lval = .false.
	return
	end if
	end do
	deallocate (et_sum)
	end do EM_ISOLATION
	deallocate (delta_r)
	deallocate (index)
	end if
	contains
	function iso_chi_gamma (dr, r0_gam, n_gam, eps_gam, pt_gam) result (iso)
	real(default) :: iso
	real(default), intent(in) :: dr, r0_gam, n_gam, eps_gam, pt_gam
	iso = eps_gam * pt_gam
	if (.not. nearly_equal (abs(n_gam), 0._default)) then
	iso = iso * ((1._default - cos(dr)) / &
	(1._default - cos(r0_gam)))**abs(n_gam)
	end if
	end function iso_chi_gamma
	end function photon_isolation_pp

	@ %def photon_isolation_pp
	@ This function evaluates an observable for a pair of particles. From the two
	particle lists, we take the first pair without [[src]] overlap. If there is
	no valid pair, we revert the status of the value to unknown.
	<<Eval trees: procedures>>=
	subroutine eval_pp (en1, en2, en0, rval, is_known)
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout) :: en0
	real(default), intent(out) :: rval
	logical, intent(out) :: is_known
	integer :: i, j, n1, n2
	n1 = en1%pval%get_length ()
	n2 = en2%pval%get_length ()
	rval = 0
	is_known = .false.
	LOOP1: do i = 1, n1
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	do j = 1, n2
	en0%prt2 = en2%pval%get_prt (j)
	if (are_disjoint (en0%prt1, en0%prt2)) then
	call eval_node_evaluate (en0)
	rval = en0%rval
	is_known = .true.
	exit LOOP1
	end if
	end do
	end do LOOP1
	end subroutine eval_pp

	@ %def eval_ppp
	@ The following function returns an integer value, namely the number
	of valid particle-pairs from both lists for which the condition is
	true. Invalid pairs (with common [[src]] entry) are ignored. If
	there is no condition, it returns the number of valid particle pairs.
	<<Eval trees: procedures>>=
	subroutine count_pp (ival, en1, en2, en0)
	integer, intent(out) :: ival
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout), optional :: en0
	integer :: i, j, n1, n2, count
	n1 = en1%pval%get_length ()
	n2 = en2%pval%get_length ()
	if (present (en0)) then
	count = 0
	do i = 1, n1
	en0%index = i
	en0%prt1 = en1%pval%get_prt (i)
	do j = 1, n2
	en0%prt2 = en2%pval%get_prt (j)
	if (are_disjoint (en0%prt1, en0%prt2)) then
	call eval_node_evaluate (en0)
	if (en0%lval) count = count + 1
	end if
	end do
	end do
	else
	count = 0
	do i = 1, n1
	do j = 1, n2
	if (are_disjoint (en1%pval%get_prt (i), &
	en2%pval%get_prt (j))) then
	count = count + 1
	end if
	end do
	end do
	end if
	ival = count
	end subroutine count_pp

	@ %def count_pp
	@ This function makes up a subevent from the second argument
	which consists only of particles which match the PDG code array (first
	argument).
	<<Eval trees: procedures>>=
	subroutine select_pdg_ca (subevt, en1, en2, en0)
	type(subevt_t), intent(inout) :: subevt
	type(eval_node_t), intent(in) :: en1, en2
	type(eval_node_t), intent(inout), optional :: en0
	if (present (en0)) then
	call subevt_select_pdg_code (subevt, en1%aval, en2%pval, en0%ival)
	else
	call subevt_select_pdg_code (subevt, en1%aval, en2%pval)
	end if
	end subroutine select_pdg_ca

	@ %def select_pdg_ca
	@
	\subsubsection{Binary string functions}
	Currently, the only string operation is concatenation.
	<<Eval trees: procedures>>=
	subroutine concat_ss (string, en1, en2)
	type(string_t), intent(out) :: string
	type(eval_node_t), intent(in) :: en1, en2
	string = en1%sval // en2%sval
	end subroutine concat_ss

	@ %def concat_ss
	@
	\subsection{Compiling the parse tree}
	The evaluation tree is built recursively by following a parse tree.
	Evaluate an expression. The requested type is given as an optional
	argument; default is numeric (integer or real).
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_genexpr &
	(en, pn, var_list, result_type)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	integer, intent(in), optional :: result_type
	if (debug_active (D_MODEL_F)) then
	print *, "read genexpr"; call parse_node_write (pn)
	end if
	if (present (result_type)) then
	select case (result_type)
	case (V_INT, V_REAL, V_CMPLX)
	call eval_node_compile_expr (en, pn, var_list)
	case (V_LOG)
	call eval_node_compile_lexpr (en, pn, var_list)
	case (V_SEV)
	call eval_node_compile_pexpr (en, pn, var_list)
	case (V_PDG)
	call eval_node_compile_cexpr (en, pn, var_list)
	case (V_STR)
	call eval_node_compile_sexpr (en, pn, var_list)
	end select
	else
	call eval_node_compile_expr (en, pn, var_list)
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done genexpr"
	end if
	end subroutine eval_node_compile_genexpr

	@ %def eval_node_compile_genexpr
	@
	\subsubsection{Numeric expressions}
	This procedure compiles a numerical expression. This is a single term
	or a sum or difference of terms. We have to account for all
	combinations of integer and real arguments. If both are constant, we
	immediately do the calculation and allocate a constant node.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_expr (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_term, pn_addition, pn_op, pn_arg
	type(eval_node_t), pointer :: en1, en2
	type(string_t) :: key
	integer :: t1, t2, t
	if (debug_active (D_MODEL_F)) then
	print *, "read expr"; call parse_node_write (pn)
	end if
	pn_term => parse_node_get_sub_ptr (pn)
	select case (char (parse_node_get_rule_key (pn_term)))
	case ("term")
	call eval_node_compile_term (en, pn_term, var_list)
	pn_addition => parse_node_get_next_ptr (pn_term, tag="addition")
	case ("addition")
	en => null ()
	pn_addition => pn_term
	case default
	call parse_node_mismatch ("term\|addition", pn)
	end select
	do while (associated (pn_addition))
	pn_op => parse_node_get_sub_ptr (pn_addition)
	pn_arg => parse_node_get_next_ptr (pn_op, tag="term")
	call eval_node_compile_term (en2, pn_arg, var_list)
	t2 = en2%result_type
	if (associated (en)) then
	en1 => en
	t1 = en1%result_type
	else
	allocate (en1)
	select case (t2)
	case (V_INT); call eval_node_init_int (en1, 0)
	case (V_REAL); call eval_node_init_real (en1, 0._default)
	case (V_CMPLX); call eval_node_init_cmplx (en1, cmplx &
	(0._default, 0._default, kind=default))
	end select
	t1 = t2
	end if
	t = numeric_result_type (t1, t2)
	allocate (en)
	key = parse_node_get_key (pn_op)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	select case (char (key))
	case ("+")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_int (en, add_ii (en1, en2))
	case (V_REAL); call eval_node_init_real (en, add_ir (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, add_ic (en1, en2))
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_real (en, add_ri (en1, en2))
	case (V_REAL); call eval_node_init_real (en, add_rr (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, add_rc (en1, en2))
	end select
	case (V_CMPLX)
	select case (t2)
	case (V_INT); call eval_node_init_cmplx (en, add_ci (en1, en2))
	case (V_REAL); call eval_node_init_cmplx (en, add_cr (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, add_cc (en1, en2))
	end select
	end select
	case ("-")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_int (en, sub_ii (en1, en2))
	case (V_REAL); call eval_node_init_real (en, sub_ir (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, sub_ic (en1, en2))
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_real (en, sub_ri (en1, en2))
	case (V_REAL); call eval_node_init_real (en, sub_rr (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, sub_rc (en1, en2))
	end select
	case (V_CMPLX)
	select case (t2)
	case (V_INT); call eval_node_init_cmplx (en, sub_ci (en1, en2))
	case (V_REAL); call eval_node_init_cmplx (en, sub_cr (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, sub_cc (en1, en2))
	end select
	end select
	end select
	call eval_node_final_rec (en1)
	call eval_node_final_rec (en2)
	deallocate (en1, en2)
	else
	call eval_node_init_branch (en, key, t, en1, en2)
	select case (char (key))
	case ("+")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_int (en, add_ii)
	case (V_REAL); call eval_node_set_op2_real (en, add_ir)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, add_ic)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_real (en, add_ri)
	case (V_REAL); call eval_node_set_op2_real (en, add_rr)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, add_rc)
	end select
	case (V_CMPLX)
	select case (t2)
	case (V_INT); call eval_node_set_op2_cmplx (en, add_ci)
	case (V_REAL); call eval_node_set_op2_cmplx (en, add_cr)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, add_cc)
	end select
	end select
	case ("-")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_int (en, sub_ii)
	case (V_REAL); call eval_node_set_op2_real (en, sub_ir)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, sub_ic)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_real (en, sub_ri)
	case (V_REAL); call eval_node_set_op2_real (en, sub_rr)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, sub_rc)
	end select
	case (V_CMPLX)
	select case (t2)
	case (V_INT); call eval_node_set_op2_cmplx (en, sub_ci)
	case (V_REAL); call eval_node_set_op2_cmplx (en, sub_cr)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, sub_cc)
	end select
	end select
	end select
	end if
	pn_addition => parse_node_get_next_ptr (pn_addition)
	end do
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done expr"
	end if
	end subroutine eval_node_compile_expr

	@ %def eval_node_compile_expr
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_term (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_factor, pn_multiplication, pn_op, pn_arg
	type(eval_node_t), pointer :: en1, en2
	type(string_t) :: key
	integer :: t1, t2, t
	if (debug_active (D_MODEL_F)) then
	print *, "read term"; call parse_node_write (pn)
	end if
	pn_factor => parse_node_get_sub_ptr (pn, tag="factor")
	call eval_node_compile_factor (en, pn_factor, var_list)
	pn_multiplication => &
	parse_node_get_next_ptr (pn_factor, tag="multiplication")
	do while (associated (pn_multiplication))
	pn_op => parse_node_get_sub_ptr (pn_multiplication)
	pn_arg => parse_node_get_next_ptr (pn_op, tag="factor")
	en1 => en
	call eval_node_compile_factor (en2, pn_arg, var_list)
	t1 = en1%result_type
	t2 = en2%result_type
	t = numeric_result_type (t1, t2)
	allocate (en)
	key = parse_node_get_key (pn_op)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	select case (char (key))
	case ("*")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_int (en, mul_ii (en1, en2))
	case (V_REAL); call eval_node_init_real (en, mul_ir (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, mul_ic (en1, en2))
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_real (en, mul_ri (en1, en2))
	case (V_REAL); call eval_node_init_real (en, mul_rr (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, mul_rc (en1, en2))
	end select
	case (V_CMPLX)
	select case (t2)
	case (V_INT); call eval_node_init_cmplx (en, mul_ci (en1, en2))
	case (V_REAL); call eval_node_init_cmplx (en, mul_cr (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, mul_cc (en1, en2))
	end select
	end select
	case ("/")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_int (en, div_ii (en1, en2))
	case (V_REAL); call eval_node_init_real (en, div_ir (en1, en2))
	case (V_CMPLX); call eval_node_init_real (en, div_ir (en1, en2))
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_real (en, div_ri (en1, en2))
	case (V_REAL); call eval_node_init_real (en, div_rr (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, div_rc (en1, en2))
	end select
	case (V_CMPLX)
	select case (t2)
	case (V_INT); call eval_node_init_cmplx (en, div_ci (en1, en2))
	case (V_REAL); call eval_node_init_cmplx (en, div_cr (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, div_cc (en1, en2))
	end select
	end select
	end select
	call eval_node_final_rec (en1)
	call eval_node_final_rec (en2)
	deallocate (en1, en2)
	else
	call eval_node_init_branch (en, key, t, en1, en2)
	select case (char (key))
	case ("*")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_int (en, mul_ii)
	case (V_REAL); call eval_node_set_op2_real (en, mul_ir)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, mul_ic)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_real (en, mul_ri)
	case (V_REAL); call eval_node_set_op2_real (en, mul_rr)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, mul_rc)
	end select
	case (V_CMPLX)
	select case (t2)
	case (V_INT); call eval_node_set_op2_cmplx (en, mul_ci)
	case (V_REAL); call eval_node_set_op2_cmplx (en, mul_cr)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, mul_cc)
	end select
	end select
	case ("/")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_int (en, div_ii)
	case (V_REAL); call eval_node_set_op2_real (en, div_ir)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, div_ic)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_real (en, div_ri)
	case (V_REAL); call eval_node_set_op2_real (en, div_rr)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, div_rc)
	end select
	case (V_CMPLX)
	select case (t2)
	case (V_INT); call eval_node_set_op2_cmplx (en, div_ci)
	case (V_REAL); call eval_node_set_op2_cmplx (en, div_cr)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, div_cc)
	end select
	end select
	end select
	end if
	pn_multiplication => parse_node_get_next_ptr (pn_multiplication)
	end do
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done term"
	end if
	end subroutine eval_node_compile_term

	@ %def eval_node_compile_term
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_factor (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_value, pn_exponentiation, pn_op, pn_arg
	type(eval_node_t), pointer :: en1, en2
	type(string_t) :: key
	integer :: t1, t2, t
	if (debug_active (D_MODEL_F)) then
	print *, "read factor"; call parse_node_write (pn)
	end if
	pn_value => parse_node_get_sub_ptr (pn)
	call eval_node_compile_signed_value (en, pn_value, var_list)
	pn_exponentiation => &
	parse_node_get_next_ptr (pn_value, tag="exponentiation")
	if (associated (pn_exponentiation)) then
	pn_op => parse_node_get_sub_ptr (pn_exponentiation)
	pn_arg => parse_node_get_next_ptr (pn_op)
	en1 => en
	call eval_node_compile_signed_value (en2, pn_arg, var_list)
	t1 = en1%result_type
	t2 = en2%result_type
	t = numeric_result_type (t1, t2)
	allocate (en)
	key = parse_node_get_key (pn_op)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_int (en, pow_ii (en1, en2))
	case (V_REAL); call eval_node_init_real (en, pow_ir (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, pow_ic (en1, en2))
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_real (en, pow_ri (en1, en2))
	case (V_REAL); call eval_node_init_real (en, pow_rr (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, pow_rc (en1, en2))
	end select
	case (V_CMPLX)
	select case (t2)
	case (V_INT); call eval_node_init_cmplx (en, pow_ci (en1, en2))
	case (V_REAL); call eval_node_init_cmplx (en, pow_cr (en1, en2))
	case (V_CMPLX); call eval_node_init_cmplx (en, pow_cc (en1, en2))
	end select
	end select
	call eval_node_final_rec (en1)
	call eval_node_final_rec (en2)
	deallocate (en1, en2)
	else
	call eval_node_init_branch (en, key, t, en1, en2)
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_int (en, pow_ii)
	case (V_REAL,V_CMPLX); call eval_type_error (pn, "exponentiation", t1)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_real (en, pow_ri)
	case (V_REAL); call eval_node_set_op2_real (en, pow_rr)
	case (V_CMPLX); call eval_type_error (pn, "exponentiation", t1)
	end select
	case (V_CMPLX)
	select case (t2)
	case (V_INT); call eval_node_set_op2_cmplx (en, pow_ci)
	case (V_REAL); call eval_node_set_op2_cmplx (en, pow_cr)
	case (V_CMPLX); call eval_node_set_op2_cmplx (en, pow_cc)
	end select
	end select
	end if
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done factor"
	end if
	end subroutine eval_node_compile_factor

	@ %def eval_node_compile_factor
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_signed_value (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_arg
	type(eval_node_t), pointer :: en1
	integer :: t
	if (debug_active (D_MODEL_F)) then
	print *, "read signed value"; call parse_node_write (pn)
	end if
	select case (char (parse_node_get_rule_key (pn)))
	case ("signed_value")
	pn_arg => parse_node_get_sub_ptr (pn, 2)
	call eval_node_compile_value (en1, pn_arg, var_list)
	t = en1%result_type
	allocate (en)
	if (en1%type == EN_CONSTANT) then
	select case (t)
	case (V_INT); call eval_node_init_int (en, neg_i (en1))
	case (V_REAL); call eval_node_init_real (en, neg_r (en1))
	case (V_CMPLX); call eval_node_init_cmplx (en, neg_c (en1))
	end select
	call eval_node_final_rec (en1)
	deallocate (en1)
	else
	call eval_node_init_branch (en, var_str ("-"), t, en1)
	select case (t)
	case (V_INT); call eval_node_set_op1_int (en, neg_i)
	case (V_REAL); call eval_node_set_op1_real (en, neg_r)
	case (V_CMPLX); call eval_node_set_op1_cmplx (en, neg_c)
	end select
	end if
	case default
	call eval_node_compile_value (en, pn, var_list)
	end select
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done signed value"
	end if
	end subroutine eval_node_compile_signed_value

	@ %def eval_node_compile_signed_value
	@ Integer, real and complex values have an optional unit. The unit is
	extracted and applied immediately. An integer with unit evaluates to
	a real constant.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_value (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	if (debug_active (D_MODEL_F)) then
	print *, "read value"; call parse_node_write (pn)
	end if
	select case (char (parse_node_get_rule_key (pn)))
	case ("integer_value", "real_value", "complex_value")
	call eval_node_compile_numeric_value (en, pn)
	case ("pi")
	call eval_node_compile_constant (en, pn)
	case ("I")
	call eval_node_compile_constant (en, pn)
	case ("variable")
	call eval_node_compile_variable (en, pn, var_list)
	case ("result")
	call eval_node_compile_result (en, pn, var_list)
	case ("expr")
	call eval_node_compile_expr (en, pn, var_list)
	case ("block_expr")
	call eval_node_compile_block_expr (en, pn, var_list)
	case ("conditional_expr")
	call eval_node_compile_conditional (en, pn, var_list)
	case ("unary_function")
	call eval_node_compile_unary_function (en, pn, var_list)
	case ("binary_function")
	call eval_node_compile_binary_function (en, pn, var_list)
	case ("eval_fun")
	call eval_node_compile_eval_function (en, pn, var_list)
	case ("count_fun")
	call eval_node_compile_count_function (en, pn, var_list)
	case ("sum_fun", "prod_fun")
	call eval_node_compile_numeric_function (en, pn, var_list)
	case default
	call parse_node_mismatch &
	("integer\|real\|complex\|constant\|variable\|" // &
	"expr\|block_expr\|conditional_expr\|" // &
	"unary_function\|binary_function\|numeric_pexpr", pn)
	end select
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done value"
	end if
	end subroutine eval_node_compile_value

	@ %def eval_node_compile_value
	@ Real, complex and integer values are numeric literals with an
	optional unit attached. In case of an integer, the unit actually
	makes it a real value in disguise. The signed version of real values
	is not possible in generic expressions; it is a special case for
	numeric constants in model files (see below). We do not introduce
	signed versions of complex values.
	<<Eval trees: procedures>>=
	subroutine eval_node_compile_numeric_value (en, pn)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in), target :: pn
	type(parse_node_t), pointer :: pn_val, pn_unit
	allocate (en)
	pn_val => parse_node_get_sub_ptr (pn)
	pn_unit => parse_node_get_next_ptr (pn_val)
	select case (char (parse_node_get_rule_key (pn)))
	case ("integer_value")
	if (associated (pn_unit)) then
	call eval_node_init_real (en, &
	parse_node_get_integer (pn_val) * parse_node_get_unit (pn_unit))
	else
	call eval_node_init_int (en, parse_node_get_integer (pn_val))
	end if
	case ("real_value")
	if (associated (pn_unit)) then
	call eval_node_init_real (en, &
	parse_node_get_real (pn_val) * parse_node_get_unit (pn_unit))
	else
	call eval_node_init_real (en, parse_node_get_real (pn_val))
	end if
	case ("complex_value")
	if (associated (pn_unit)) then
	call eval_node_init_cmplx (en, &
	parse_node_get_cmplx (pn_val) * parse_node_get_unit (pn_unit))
	else
	call eval_node_init_cmplx (en, parse_node_get_cmplx (pn_val))
	end if
	case ("neg_real_value")
	pn_val => parse_node_get_sub_ptr (parse_node_get_sub_ptr (pn, 2))
	pn_unit => parse_node_get_next_ptr (pn_val)
	if (associated (pn_unit)) then
	call eval_node_init_real (en, &
	- parse_node_get_real (pn_val) * parse_node_get_unit (pn_unit))
	else
	call eval_node_init_real (en, - parse_node_get_real (pn_val))
	end if
	case ("pos_real_value")
	pn_val => parse_node_get_sub_ptr (parse_node_get_sub_ptr (pn, 2))
	pn_unit => parse_node_get_next_ptr (pn_val)
	if (associated (pn_unit)) then
	call eval_node_init_real (en, &
	parse_node_get_real (pn_val) * parse_node_get_unit (pn_unit))
	else
	call eval_node_init_real (en, parse_node_get_real (pn_val))
	end if
	case default
	call parse_node_mismatch &
	("integer_value\|real_value\|complex_value\|neg_real_value\|pos_real_value", pn)
	end select
	end subroutine eval_node_compile_numeric_value

	@ %def eval_node_compile_numeric_value
	@ These are the units, predefined and hardcoded. The default energy
	unit is GeV, the default angular unit is radians. We include units
	for observables of dimension energy squared. Luminosities are
	normalized in inverse femtobarns.
	<<Eval trees: procedures>>=
	function parse_node_get_unit (pn) result (factor)
	real(default) :: factor
	real(default) :: unit
	type(parse_node_t), intent(in) :: pn
	type(parse_node_t), pointer :: pn_unit, pn_unit_power
	type(parse_node_t), pointer :: pn_frac, pn_num, pn_int, pn_div, pn_den
	integer :: num, den
	pn_unit => parse_node_get_sub_ptr (pn)
	select case (char (parse_node_get_key (pn_unit)))
	case ("TeV"); unit = 1.e3_default
	case ("GeV"); unit = 1
	case ("MeV"); unit = 1.e-3_default
	case ("keV"); unit = 1.e-6_default
	case ("eV"); unit = 1.e-9_default
	case ("meV"); unit = 1.e-12_default
	case ("nbarn"); unit = 1.e6_default
	case ("pbarn"); unit = 1.e3_default
	case ("fbarn"); unit = 1
	case ("abarn"); unit = 1.e-3_default
	case ("rad"); unit = 1
	case ("mrad"); unit = 1.e-3_default
	case ("degree"); unit = degree
	case ("%"); unit = 1.e-2_default
	case default
	call msg_bug (" Unit '" // &
	char (parse_node_get_key (pn)) // "' is undefined.")
	end select
	pn_unit_power => parse_node_get_next_ptr (pn_unit)
	if (associated (pn_unit_power)) then
	pn_frac => parse_node_get_sub_ptr (pn_unit_power, 2)
	pn_num => parse_node_get_sub_ptr (pn_frac)
	select case (char (parse_node_get_rule_key (pn_num)))
	case ("neg_int")
	pn_int => parse_node_get_sub_ptr (pn_num, 2)
	num = - parse_node_get_integer (pn_int)
	case ("pos_int")
	pn_int => parse_node_get_sub_ptr (pn_num, 2)
	num = parse_node_get_integer (pn_int)
	case ("integer_literal")
	num = parse_node_get_integer (pn_num)
	case default
	call parse_node_mismatch ("neg_int\|pos_int\|integer_literal", pn_num)
	end select
	pn_div => parse_node_get_next_ptr (pn_num)
	if (associated (pn_div)) then
	pn_den => parse_node_get_sub_ptr (pn_div, 2)
	den = parse_node_get_integer (pn_den)
	else
	den = 1
	end if
	else
	num = 1
	den = 1
	end if
	factor = unit ** (real (num, default) / den)
	end function parse_node_get_unit

	@ %def parse_node_get_unit
	@ There are only two predefined constants, but more can be added easily.
	<<Eval trees: procedures>>=
	subroutine eval_node_compile_constant (en, pn)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	if (debug_active (D_MODEL_F)) then
	print *, "read constant"; call parse_node_write (pn)
	end if
	allocate (en)
	select case (char (parse_node_get_key (pn)))
	case ("pi"); call eval_node_init_real (en, pi)
	case ("I"); call eval_node_init_cmplx (en, imago)
	case default
	call parse_node_mismatch ("pi or I", pn)
	end select
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done constant"
	end if
	end subroutine eval_node_compile_constant

	@ %def eval_node_compile_constant
	@ Compile a variable, with or without a specified type.
	Take the list of variables, look for the name and make a node with a
	pointer to the value. If no type is provided, the variable is
	numeric, and the stored value determines whether it is real or integer.

	We explicitly demand that the variable is defined, so we do not accidentally
	point to variables that are declared only later in the script but have come
	into existence in a previous compilation pass.

	Variables may actually be anonymous, these are expressions in disguise. In
	that case, the expression replaces the variable name in the parse tree, and we
	allocate an ordinary expression node in the eval tree.

	Variables of type [[V_PDG]] (pdg-code array) are not treated here.
	They are handled by [[eval_node_compile_cvariable]].
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_variable (en, pn, var_list, var_type)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in), target :: pn
	type(var_list_t), intent(in), target :: var_list
	integer, intent(in), optional :: var_type
	type(parse_node_t), pointer :: pn_name
	type(string_t) :: var_name
	logical, target, save :: no_lval
	real(default), target, save :: no_rval
	type(subevt_t), target, save :: no_pval
	type(string_t), target, save :: no_sval
	logical, target, save :: unknown = .false.
	integer :: type
	logical :: defined
	logical, pointer :: known
	logical, pointer :: lptr
	integer, pointer :: iptr
	real(default), pointer :: rptr
	complex(default), pointer :: cptr
	type(subevt_t), pointer :: pptr
	type(string_t), pointer :: sptr
	procedure(obs_unary_int), pointer :: obs1_iptr
	procedure(obs_unary_real), pointer :: obs1_rptr
	procedure(obs_binary_int), pointer :: obs2_iptr
	procedure(obs_binary_real), pointer :: obs2_rptr
	procedure(obs_sev_int), pointer :: obsev_iptr
	procedure(obs_sev_real), pointer :: obsev_rptr
	type(prt_t), pointer :: p1, p2
	if (debug_active (D_MODEL_F)) then
	print *, "read variable"; call parse_node_write (pn)
	end if
	if (present (var_type)) then
	select case (var_type)
	case (V_REAL, V_OBS1_REAL, V_OBS2_REAL, V_INT, V_OBS1_INT, &
	V_OBS2_INT, V_CMPLX)
	pn_name => pn
	case default
	pn_name => parse_node_get_sub_ptr (pn, 2)
	end select
	else
	pn_name => pn
	end if
	select case (char (parse_node_get_rule_key (pn_name)))
	case ("expr")
	call eval_node_compile_expr (en, pn_name, var_list)
	case ("lexpr")
	call eval_node_compile_lexpr (en, pn_name, var_list)
	case ("sexpr")
	call eval_node_compile_sexpr (en, pn_name, var_list)
	case ("pexpr")
	call eval_node_compile_pexpr (en, pn_name, var_list)
	case ("variable")
	var_name = parse_node_get_string (pn_name)
	if (present (var_type)) then
	select case (var_type)
	case (V_LOG); var_name = "?" // var_name
	case (V_SEV); var_name = "@" // var_name
	case (V_STR); var_name = "$" // var_name ! $ sign
	end select
	end if
	call var_list%get_var_properties &
	(var_name, req_type=var_type, type=type, is_defined=defined)
	allocate (en)
	if (defined) then
	select case (type)
	case (V_LOG)
	call var_list%get_lptr (var_name, lptr, known)
	call eval_node_init_log_ptr (en, var_name, lptr, known)
	case (V_INT)
	call var_list%get_iptr (var_name, iptr, known)
	call eval_node_init_int_ptr (en, var_name, iptr, known)
	case (V_REAL)
	call var_list%get_rptr (var_name, rptr, known)
	call eval_node_init_real_ptr (en, var_name, rptr, known)
	case (V_CMPLX)
	call var_list%get_cptr (var_name, cptr, known)
	call eval_node_init_cmplx_ptr (en, var_name, cptr, known)
	case (V_SEV)
	call var_list%get_pptr (var_name, pptr, known)
	call eval_node_init_subevt_ptr (en, var_name, pptr, known)
	case (V_STR)
	call var_list%get_sptr (var_name, sptr, known)
	call eval_node_init_string_ptr (en, var_name, sptr, known)
	case (V_OBS1_INT)
	call var_list%get_obs1_iptr (var_name, obs1_iptr, p1)
	call eval_node_init_obs1_int_ptr (en, var_name, obs1_iptr, p1)
	case (V_OBS2_INT)
	call var_list%get_obs2_iptr (var_name, obs2_iptr, p1, p2)
	call eval_node_init_obs2_int_ptr (en, var_name, obs2_iptr, p1, p2)
	case (V_OBSEV_INT)
	call var_list%get_obsev_iptr (var_name, obsev_iptr, pptr)
	call eval_node_init_obsev_int_ptr (en, var_name, obsev_iptr, pptr)
	case (V_OBS1_REAL)
	call var_list%get_obs1_rptr (var_name, obs1_rptr, p1)
	call eval_node_init_obs1_real_ptr (en, var_name, obs1_rptr, p1)
	case (V_OBS2_REAL)
	call var_list%get_obs2_rptr (var_name, obs2_rptr, p1, p2)
	call eval_node_init_obs2_real_ptr (en, var_name, obs2_rptr, p1, p2)
	case (V_OBSEV_REAL)
	call var_list%get_obsev_rptr (var_name, obsev_rptr, pptr)
	call eval_node_init_obsev_real_ptr (en, var_name, obsev_rptr, pptr)
	case default
	call parse_node_write (pn)
	call msg_fatal ("Variable of this type " // &
	"is not allowed in the present context")
	if (present (var_type)) then
	select case (var_type)
	case (V_LOG)
	call eval_node_init_log_ptr (en, var_name, no_lval, unknown)
	case (V_SEV)
	call eval_node_init_subevt_ptr &
	(en, var_name, no_pval, unknown)
	case (V_STR)
	call eval_node_init_string_ptr &
	(en, var_name, no_sval, unknown)
	end select
	else
	call eval_node_init_real_ptr (en, var_name, no_rval, unknown)
	end if
	end select
	else
	call parse_node_write (pn)
	call msg_error ("This variable is undefined at this point")
	if (present (var_type)) then
	select case (var_type)
	case (V_LOG)
	call eval_node_init_log_ptr (en, var_name, no_lval, unknown)
	case (V_SEV)
	call eval_node_init_subevt_ptr &
	(en, var_name, no_pval, unknown)
	case (V_STR)
	call eval_node_init_string_ptr (en, var_name, no_sval, unknown)
	end select
	else
	call eval_node_init_real_ptr (en, var_name, no_rval, unknown)
	end if
	end if
	end select
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done variable"
	end if
	end subroutine eval_node_compile_variable

	@ %def eval_node_compile_variable
	@ In a given context, a variable has to have a certain type.
	<<Eval trees: procedures>>=
	subroutine check_var_type (pn, ok, type_actual, type_requested)
	type(parse_node_t), intent(in) :: pn
	logical, intent(out) :: ok
	integer, intent(in) :: type_actual
	integer, intent(in), optional :: type_requested
	if (present (type_requested)) then
	select case (type_requested)
	case (V_LOG)
	select case (type_actual)
	case (V_LOG)
	case default
	call parse_node_write (pn)
	call msg_fatal ("Variable type is invalid (should be logical)")
	ok = .false.
	end select
	case (V_SEV)
	select case (type_actual)
	case (V_SEV)
	case default
	call parse_node_write (pn)
	call msg_fatal &
	("Variable type is invalid (should be particle set)")
	ok = .false.
	end select
	case (V_PDG)
	select case (type_actual)
	case (V_PDG)
	case default
	call parse_node_write (pn)
	call msg_fatal &
	("Variable type is invalid (should be PDG array)")
	ok = .false.
	end select
	case (V_STR)
	select case (type_actual)
	case (V_STR)
	case default
	call parse_node_write (pn)
	call msg_fatal &
	("Variable type is invalid (should be string)")
	ok = .false.
	end select
	case default
	call parse_node_write (pn)
	call msg_bug ("Variable type is unknown")
	end select
	else
	select case (type_actual)
	case (V_REAL, V_OBS1_REAL, V_OBS2_REAL, V_INT, V_OBS1_INT, &
	V_OBS2_INT, V_CMPLX)
	case default
	call parse_node_write (pn)
	call msg_fatal ("Variable type is invalid (should be numeric)")
	ok = .false.
	end select
	end if
	ok = .true.
	end subroutine check_var_type

	@ %def check_var_type
	@ Retrieve the result of an integration. If the requested process has
	been integrated, the results are available as special variables. (The
	variables cannot be accessed in the usual way since they contain
	brackets in their names.)

	Since this compilation step may occur before the processes have been
	loaded, we have to initialize the required variables before they are
	used.
	<<Eval trees: procedures>>=
	subroutine eval_node_compile_result (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in), target :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_key, pn_prc_id
	type(string_t) :: key, prc_id, var_name
	integer, pointer :: iptr
	real(default), pointer :: rptr
	logical, pointer :: known
	if (debug_active (D_MODEL_F)) then
	print *, "read result"; call parse_node_write (pn)
	end if
	pn_key => parse_node_get_sub_ptr (pn)
	pn_prc_id => parse_node_get_next_ptr (pn_key)
	key = parse_node_get_key (pn_key)
	prc_id = parse_node_get_string (pn_prc_id)
	var_name = key // "(" // prc_id // ")"
	if (var_list%contains (var_name)) then
	allocate (en)
	select case (char(key))
	case ("num_id", "n_calls")
	call var_list%get_iptr (var_name, iptr, known)
	call eval_node_init_int_ptr (en, var_name, iptr, known)
	case ("integral", "error")
	call var_list%get_rptr (var_name, rptr, known)
	call eval_node_init_real_ptr (en, var_name, rptr, known)
	end select
	else
	call msg_fatal ("Result variable '" // char (var_name) &
	// "' is undefined (call 'integrate' before use)")
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done result"
	end if
	end subroutine eval_node_compile_result

	@ %def eval_node_compile_result
	@ Functions with a single argument. For non-constant arguments, watch
	for functions which convert their argument to a different type.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_unary_function (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_fname, pn_arg
	type(eval_node_t), pointer :: en1
	type(string_t) :: key
	integer :: t
	if (debug_active (D_MODEL_F)) then
	print *, "read unary function"; call parse_node_write (pn)
	end if
	pn_fname => parse_node_get_sub_ptr (pn)
	pn_arg => parse_node_get_next_ptr (pn_fname, tag="function_arg1")
	call eval_node_compile_expr &
	(en1, parse_node_get_sub_ptr (pn_arg, tag="expr"), var_list)
	t = en1%result_type
	allocate (en)
	key = parse_node_get_key (pn_fname)
	if (en1%type == EN_CONSTANT) then
	select case (char (key))
	case ("complex")
	select case (t)
	case (V_INT); call eval_node_init_cmplx (en, cmplx_i (en1))
	case (V_REAL); call eval_node_init_cmplx (en, cmplx_r (en1))
	case (V_CMPLX); deallocate (en); en => en1; en1 => null ()
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("real")
	select case (t)
	case (V_INT); call eval_node_init_real (en, real_i (en1))
	case (V_REAL); deallocate (en); en => en1; en1 => null ()
	case (V_CMPLX); call eval_node_init_real (en, real_c (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("int")
	select case (t)
	case (V_INT); deallocate (en); en => en1; en1 => null ()
	case (V_REAL); call eval_node_init_int (en, int_r (en1))
	case (V_CMPLX); call eval_node_init_int (en, int_c (en1))
	end select
	case ("nint")
	select case (t)
	case (V_INT); deallocate (en); en => en1; en1 => null ()
	case (V_REAL); call eval_node_init_int (en, nint_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("floor")
	select case (t)
	case (V_INT); deallocate (en); en => en1; en1 => null ()
	case (V_REAL); call eval_node_init_int (en, floor_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("ceiling")
	select case (t)
	case (V_INT); deallocate (en); en => en1; en1 => null ()
	case (V_REAL); call eval_node_init_int (en, ceiling_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("abs")
	select case (t)
	case (V_INT); call eval_node_init_int (en, abs_i (en1))
	case (V_REAL); call eval_node_init_real (en, abs_r (en1))
	case (V_CMPLX); call eval_node_init_real (en, abs_c (en1))
	end select
	case ("conjg")
	select case (t)
	case (V_INT); call eval_node_init_int (en, conjg_i (en1))
	case (V_REAL); call eval_node_init_real (en, conjg_r (en1))
	case (V_CMPLX); call eval_node_init_cmplx (en, conjg_c (en1))
	end select
	case ("sgn")
	select case (t)
	case (V_INT); call eval_node_init_int (en, sgn_i (en1))
	case (V_REAL); call eval_node_init_real (en, sgn_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("sqrt")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, sqrt_r (en1))
	case (V_CMPLX); call eval_node_init_cmplx (en, sqrt_c (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("exp")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, exp_r (en1))
	case (V_CMPLX); call eval_node_init_cmplx (en, exp_c (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("log")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, log_r (en1))
	case (V_CMPLX); call eval_node_init_cmplx (en, log_c (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("log10")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, log10_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("sin")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, sin_r (en1))
	case (V_CMPLX); call eval_node_init_cmplx (en, sin_c (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("cos")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, cos_r (en1))
	case (V_CMPLX); call eval_node_init_cmplx (en, cos_c (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("tan")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, tan_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("asin")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, asin_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("acos")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, acos_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("atan")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, atan_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("sinh")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, sinh_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("cosh")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, cosh_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("tanh")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, tanh_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("asinh")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, asinh_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("acosh")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, acosh_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("atanh")
	select case (t)
	case (V_REAL); call eval_node_init_real (en, atanh_r (en1))
	case default; call eval_type_error (pn, char (key), t)
	end select
	case default
	call parse_node_mismatch ("function name", pn_fname)
	end select
	if (associated (en1)) then
	call eval_node_final_rec (en1)
	deallocate (en1)
	end if
	else
	select case (char (key))
	case ("complex")
	call eval_node_init_branch (en, key, V_CMPLX, en1)
	case ("real")
	call eval_node_init_branch (en, key, V_REAL, en1)
	case ("int", "nint", "floor", "ceiling")
	call eval_node_init_branch (en, key, V_INT, en1)
	case default
	call eval_node_init_branch (en, key, t, en1)
	end select
	select case (char (key))
	case ("complex")
	select case (t)
	case (V_INT); call eval_node_set_op1_cmplx (en, cmplx_i)
	case (V_REAL); call eval_node_set_op1_cmplx (en, cmplx_r)
	case (V_CMPLX); deallocate (en); en => en1
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("real")
	select case (t)
	case (V_INT); call eval_node_set_op1_real (en, real_i)
	case (V_REAL); deallocate (en); en => en1
	case (V_CMPLX); call eval_node_set_op1_real (en, real_c)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("int")
	select case (t)
	case (V_INT); deallocate (en); en => en1
	case (V_REAL); call eval_node_set_op1_int (en, int_r)
	case (V_CMPLX); call eval_node_set_op1_int (en, int_c)
	end select
	case ("nint")
	select case (t)
	case (V_INT); deallocate (en); en => en1
	case (V_REAL); call eval_node_set_op1_int (en, nint_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("floor")
	select case (t)
	case (V_INT); deallocate (en); en => en1
	case (V_REAL); call eval_node_set_op1_int (en, floor_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("ceiling")
	select case (t)
	case (V_INT); deallocate (en); en => en1
	case (V_REAL); call eval_node_set_op1_int (en, ceiling_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("abs")
	select case (t)
	case (V_INT); call eval_node_set_op1_int (en, abs_i)
	case (V_REAL); call eval_node_set_op1_real (en, abs_r)
	case (V_CMPLX);
	call eval_node_init_branch (en, key, V_REAL, en1)
	call eval_node_set_op1_real (en, abs_c)
	end select
	case ("conjg")
	select case (t)
	case (V_INT); call eval_node_set_op1_int (en, conjg_i)
	case (V_REAL); call eval_node_set_op1_real (en, conjg_r)
	case (V_CMPLX); call eval_node_set_op1_cmplx (en, conjg_c)
	end select
	case ("sgn")
	select case (t)
	case (V_INT); call eval_node_set_op1_int (en, sgn_i)
	case (V_REAL); call eval_node_set_op1_real (en, sgn_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("sqrt")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, sqrt_r)
	case (V_CMPLX); call eval_node_set_op1_cmplx (en, sqrt_c)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("exp")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, exp_r)
	case (V_CMPLX); call eval_node_set_op1_cmplx (en, exp_c)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("log")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, log_r)
	case (V_CMPLX); call eval_node_set_op1_cmplx (en, log_c)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("log10")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, log10_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("sin")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, sin_r)
	case (V_CMPLX); call eval_node_set_op1_cmplx (en, sin_c)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("cos")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, cos_r)
	case (V_CMPLX); call eval_node_set_op1_cmplx (en, cos_c)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("tan")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, tan_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("asin")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, asin_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("acos")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, acos_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("atan")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, atan_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("sinh")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, sinh_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("cosh")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, cosh_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("tanh")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, tanh_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("asinh")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, asinh_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("acosh")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, acosh_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case ("atanh")
	select case (t)
	case (V_REAL); call eval_node_set_op1_real (en, atanh_r)
	case default; call eval_type_error (pn, char (key), t)
	end select
	case default
	call parse_node_mismatch ("function name", pn_fname)
	end select
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done function"
	end if
	end subroutine eval_node_compile_unary_function

	@ %def eval_node_compile_unary_function
	@ Functions with two arguments.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_binary_function (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_fname, pn_arg, pn_arg1, pn_arg2
	type(eval_node_t), pointer :: en1, en2
	type(string_t) :: key
	integer :: t1, t2
	if (debug_active (D_MODEL_F)) then
	print *, "read binary function"; call parse_node_write (pn)
	end if
	pn_fname => parse_node_get_sub_ptr (pn)
	pn_arg => parse_node_get_next_ptr (pn_fname, tag="function_arg2")
	pn_arg1 => parse_node_get_sub_ptr (pn_arg, tag="expr")
	pn_arg2 => parse_node_get_next_ptr (pn_arg1, tag="expr")
	call eval_node_compile_expr (en1, pn_arg1, var_list)
	call eval_node_compile_expr (en2, pn_arg2, var_list)
	t1 = en1%result_type
	t2 = en2%result_type
	allocate (en)
	key = parse_node_get_key (pn_fname)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	select case (char (key))
	case ("max")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_int (en, max_ii (en1, en2))
	case (V_REAL); call eval_node_init_real (en, max_ir (en1, en2))
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_real (en, max_ri (en1, en2))
	case (V_REAL); call eval_node_init_real (en, max_rr (en1, en2))
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case default; call eval_type_error (pn, char (key), t1)
	end select
	case ("min")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_int (en, min_ii (en1, en2))
	case (V_REAL); call eval_node_init_real (en, min_ir (en1, en2))
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_real (en, min_ri (en1, en2))
	case (V_REAL); call eval_node_init_real (en, min_rr (en1, en2))
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case default; call eval_type_error (pn, char (key), t1)
	end select
	case ("mod")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_int (en, mod_ii (en1, en2))
	case (V_REAL); call eval_node_init_real (en, mod_ir (en1, en2))
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_real (en, mod_ri (en1, en2))
	case (V_REAL); call eval_node_init_real (en, mod_rr (en1, en2))
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case default; call eval_type_error (pn, char (key), t1)
	end select
	case ("modulo")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_int (en, modulo_ii (en1, en2))
	case (V_REAL); call eval_node_init_real (en, modulo_ir (en1, en2))
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_real (en, modulo_ri (en1, en2))
	case (V_REAL); call eval_node_init_real (en, modulo_rr (en1, en2))
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case default
	call parse_node_mismatch ("function name", pn_fname)
	end select
	call eval_node_final_rec (en1)
	deallocate (en1)
	else
	call eval_node_init_branch (en, key, t1, en1, en2)
	select case (char (key))
	case ("max")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_int (en, max_ii)
	case (V_REAL); call eval_node_set_op2_real (en, max_ir)
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_real (en, max_ri)
	case (V_REAL); call eval_node_set_op2_real (en, max_rr)
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case ("min")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_int (en, min_ii)
	case (V_REAL); call eval_node_set_op2_real (en, min_ir)
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_real (en, min_ri)
	case (V_REAL); call eval_node_set_op2_real (en, min_rr)
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case ("mod")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_int (en, mod_ii)
	case (V_REAL); call eval_node_set_op2_real (en, mod_ir)
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_real (en, mod_ri)
	case (V_REAL); call eval_node_set_op2_real (en, mod_rr)
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case ("modulo")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_int (en, modulo_ii)
	case (V_REAL); call eval_node_set_op2_real (en, modulo_ir)
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_real (en, modulo_ri)
	case (V_REAL); call eval_node_set_op2_real (en, modulo_rr)
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case default; call eval_type_error (pn, char (key), t2)
	end select
	case default
	call parse_node_mismatch ("function name", pn_fname)
	end select
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done function"
	end if
	end subroutine eval_node_compile_binary_function

	@ %def eval_node_compile_binary_function
	@
	\subsubsection{Variable definition}
	A block expression contains a variable definition (first argument) and
	an expression where the definition can be used (second argument). The
	[[result_type]] decides which type of expression is expected for the
	second argument. For numeric variables, if there is a mismatch
	between real and integer type, insert an extra node for type
	conversion.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_block_expr &
	(en, pn, var_list, result_type)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	integer, intent(in), optional :: result_type
	type(parse_node_t), pointer :: pn_var_spec, pn_var_subspec
	type(parse_node_t), pointer :: pn_var_type, pn_var_name, pn_var_expr
	type(parse_node_t), pointer :: pn_expr
	type(string_t) :: var_name
	type(eval_node_t), pointer :: en1, en2
	integer :: var_type
	logical :: new
	if (debug_active (D_MODEL_F)) then
	print *, "read block expr"; call parse_node_write (pn)
	end if
	new = .false.
	pn_var_spec => parse_node_get_sub_ptr (pn, 2)
	select case (char (parse_node_get_rule_key (pn_var_spec)))
	case ("var_num"); var_type = V_NONE
	pn_var_name => parse_node_get_sub_ptr (pn_var_spec)
	case ("var_int"); var_type = V_INT
	new = .true.
	pn_var_name => parse_node_get_sub_ptr (pn_var_spec, 2)
	case ("var_real"); var_type = V_REAL
	new = .true.
	pn_var_name => parse_node_get_sub_ptr (pn_var_spec, 2)
	case ("var_cmplx"); var_type = V_CMPLX
	new = .true.
	pn_var_name => parse_node_get_sub_ptr (pn_var_spec, 2)
	case ("var_logical_new"); var_type = V_LOG
	new = .true.
	pn_var_subspec => parse_node_get_sub_ptr (pn_var_spec, 2)
	pn_var_name => parse_node_get_sub_ptr (pn_var_subspec, 2)
	case ("var_logical_spec"); var_type = V_LOG
	pn_var_name => parse_node_get_sub_ptr (pn_var_spec, 2)
	case ("var_plist_new"); var_type = V_SEV
	new = .true.
	pn_var_subspec => parse_node_get_sub_ptr (pn_var_spec, 2)
	pn_var_name => parse_node_get_sub_ptr (pn_var_subspec, 2)
	case ("var_plist_spec"); var_type = V_SEV
	new = .true.
	pn_var_name => parse_node_get_sub_ptr (pn_var_spec, 2)
	case ("var_alias"); var_type = V_PDG
	new = .true.
	pn_var_name => parse_node_get_sub_ptr (pn_var_spec, 2)
	case ("var_string_new"); var_type = V_STR
	new = .true.
	pn_var_subspec => parse_node_get_sub_ptr (pn_var_spec, 2)
	pn_var_name => parse_node_get_sub_ptr (pn_var_subspec, 2)
	case ("var_string_spec"); var_type = V_STR
	pn_var_name => parse_node_get_sub_ptr (pn_var_spec, 2)
	case default
	call parse_node_mismatch &
	("logical\|int\|real\|plist\|alias", pn_var_type)
	end select
	pn_var_expr => parse_node_get_next_ptr (pn_var_name, 2)
	pn_expr => parse_node_get_next_ptr (pn_var_spec, 2)
	var_name = parse_node_get_string (pn_var_name)
	select case (var_type)
	case (V_LOG); var_name = "?" // var_name
	case (V_SEV); var_name = "@" // var_name
	case (V_STR); var_name = "$" // var_name ! $ sign
	end select
	call var_list%check_user_var (var_name, var_type, new)
	call eval_node_compile_genexpr (en1, pn_var_expr, var_list, var_type)
	call insert_conversion_node (en1, var_type)
	allocate (en)
	call eval_node_init_block (en, var_name, var_type, en1, var_list)
	call eval_node_compile_genexpr (en2, pn_expr, en%var_list, result_type)
	call eval_node_set_expr (en, en2)
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done block expr"
	end if
	end subroutine eval_node_compile_block_expr

	@ %def eval_node_compile_block_expr
	@ Insert a conversion node for integer/real/complex transformation if necessary.
	What shall we do for the complex to integer/real conversion?
	<<Eval trees: procedures>>=
	subroutine insert_conversion_node (en, result_type)
	type(eval_node_t), pointer :: en
	integer, intent(in) :: result_type
	type(eval_node_t), pointer :: en_conv
	select case (en%result_type)
	case (V_INT)
	select case (result_type)
	case (V_REAL)
	allocate (en_conv)
	call eval_node_init_branch (en_conv, var_str ("real"), V_REAL, en)
	call eval_node_set_op1_real (en_conv, real_i)
	en => en_conv
	case (V_CMPLX)
	allocate (en_conv)
	call eval_node_init_branch (en_conv, var_str ("complex"), V_CMPLX, en)
	call eval_node_set_op1_cmplx (en_conv, cmplx_i)
	en => en_conv
	end select
	case (V_REAL)
	select case (result_type)
	case (V_INT)
	allocate (en_conv)
	call eval_node_init_branch (en_conv, var_str ("int"), V_INT, en)
	call eval_node_set_op1_int (en_conv, int_r)
	en => en_conv
	case (V_CMPLX)
	allocate (en_conv)
	call eval_node_init_branch (en_conv, var_str ("complex"), V_CMPLX, en)
	call eval_node_set_op1_cmplx (en_conv, cmplx_r)
	en => en_conv
	end select
	case (V_CMPLX)
	select case (result_type)
	case (V_INT)
	allocate (en_conv)
	call eval_node_init_branch (en_conv, var_str ("int"), V_INT, en)
	call eval_node_set_op1_int (en_conv, int_c)
	en => en_conv
	case (V_REAL)
	allocate (en_conv)
	call eval_node_init_branch (en_conv, var_str ("real"), V_REAL, en)
	call eval_node_set_op1_real (en_conv, real_c)
	en => en_conv
	end select
	case default
	end select
	end subroutine insert_conversion_node

	@ %def insert_conversion_node
	@
	\subsubsection{Conditionals}
	A conditional has the structure if lexpr then expr else expr. So we
	first evaluate the logical expression, then depending on the result
	the first or second expression. Note that the second expression is
	mandatory.

	The [[result_type]], if present, defines the requested type of the
	[[then]] and [[else]] clauses. Default is numeric (int/real). If
	there is a mismatch between real and integer result types, insert
	conversion nodes.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_conditional &
	(en, pn, var_list, result_type)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	integer, intent(in), optional :: result_type
	type(parse_node_t), pointer :: pn_condition, pn_expr
	type(parse_node_t), pointer :: pn_maybe_elsif, pn_elsif_branch
	type(parse_node_t), pointer :: pn_maybe_else, pn_else_branch, pn_else_expr
	type(eval_node_t), pointer :: en0, en1, en2
	integer :: restype
	if (debug_active (D_MODEL_F)) then
	print *, "read conditional"; call parse_node_write (pn)
	end if
	pn_condition => parse_node_get_sub_ptr (pn, 2, tag="lexpr")
	pn_expr => parse_node_get_next_ptr (pn_condition, 2)
	call eval_node_compile_lexpr (en0, pn_condition, var_list)
	call eval_node_compile_genexpr (en1, pn_expr, var_list, result_type)
	if (present (result_type)) then
	restype = major_result_type (result_type, en1%result_type)
	else
	restype = en1%result_type
	end if
	pn_maybe_elsif => parse_node_get_next_ptr (pn_expr)
	select case (char (parse_node_get_rule_key (pn_maybe_elsif)))
	case ("maybe_elsif_expr", &
	"maybe_elsif_lexpr", &
	"maybe_elsif_pexpr", &
	"maybe_elsif_cexpr", &
	"maybe_elsif_sexpr")
	pn_elsif_branch => parse_node_get_sub_ptr (pn_maybe_elsif)
	pn_maybe_else => parse_node_get_next_ptr (pn_maybe_elsif)
	select case (char (parse_node_get_rule_key (pn_maybe_else)))
	case ("maybe_else_expr", &
	"maybe_else_lexpr", &
	"maybe_else_pexpr", &
	"maybe_else_cexpr", &
	"maybe_else_sexpr")
	pn_else_branch => parse_node_get_sub_ptr (pn_maybe_else)
	pn_else_expr => parse_node_get_sub_ptr (pn_else_branch, 2)
	case default
	pn_else_expr => null ()
	end select
	call eval_node_compile_elsif &
	(en2, pn_elsif_branch, pn_else_expr, var_list, restype)
	case ("maybe_else_expr", &
	"maybe_else_lexpr", &
	"maybe_else_pexpr", &
	"maybe_else_cexpr", &
	"maybe_else_sexpr")
	pn_maybe_else => pn_maybe_elsif
	pn_maybe_elsif => null ()
	pn_else_branch => parse_node_get_sub_ptr (pn_maybe_else)
	pn_else_expr => parse_node_get_sub_ptr (pn_else_branch, 2)
	call eval_node_compile_genexpr &
	(en2, pn_else_expr, var_list, restype)
	case ("endif")
	call eval_node_compile_default_else (en2, restype)
	case default
	call msg_bug ("Broken conditional: unexpected " &
	// char (parse_node_get_rule_key (pn_maybe_elsif)))
	end select
	call eval_node_create_conditional (en, en0, en1, en2, restype)
	call conditional_insert_conversion_nodes (en, restype)
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done conditional"
	end if
	end subroutine eval_node_compile_conditional

	@ %def eval_node_compile_conditional
	@ This recursively generates 'elsif' conditionals as a chain of sub-nodes of
	the main conditional.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_elsif &
	(en, pn, pn_else_expr, var_list, result_type)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in), target :: pn
	type(parse_node_t), pointer :: pn_else_expr
	type(var_list_t), intent(in), target :: var_list
	integer, intent(inout) :: result_type
	type(parse_node_t), pointer :: pn_next, pn_condition, pn_expr
	type(eval_node_t), pointer :: en0, en1, en2
	pn_condition => parse_node_get_sub_ptr (pn, 2, tag="lexpr")
	pn_expr => parse_node_get_next_ptr (pn_condition, 2)
	call eval_node_compile_lexpr (en0, pn_condition, var_list)
	call eval_node_compile_genexpr (en1, pn_expr, var_list, result_type)
	result_type = major_result_type (result_type, en1%result_type)
	pn_next => parse_node_get_next_ptr (pn)
	if (associated (pn_next)) then
	call eval_node_compile_elsif &
	(en2, pn_next, pn_else_expr, var_list, result_type)
	result_type = major_result_type (result_type, en2%result_type)
	else if (associated (pn_else_expr)) then
	call eval_node_compile_genexpr &
	(en2, pn_else_expr, var_list, result_type)
	result_type = major_result_type (result_type, en2%result_type)
	else
	call eval_node_compile_default_else (en2, result_type)
	end if
	call eval_node_create_conditional (en, en0, en1, en2, result_type)
	end subroutine eval_node_compile_elsif

	@ %def eval_node_compile_elsif
	@ This makes a default 'else' branch in case it was omitted. The default value
	just depends on the expected type.
	<<Eval trees: procedures>>=
	subroutine eval_node_compile_default_else (en, result_type)
	type(eval_node_t), pointer :: en
	integer, intent(in) :: result_type
	type(subevt_t) :: pval_empty
	type(pdg_array_t) :: aval_undefined
	allocate (en)
	select case (result_type)
	case (V_LOG); call eval_node_init_log (en, .false.)
	case (V_INT); call eval_node_init_int (en, 0)
	case (V_REAL); call eval_node_init_real (en, 0._default)
	case (V_CMPLX)
	call eval_node_init_cmplx (en, (0._default, 0._default))
	case (V_SEV)
	call subevt_init (pval_empty)
	call eval_node_init_subevt (en, pval_empty)
	case (V_PDG)
	call eval_node_init_pdg_array (en, aval_undefined)
	case (V_STR)
	call eval_node_init_string (en, var_str (""))
	case default
	call msg_bug ("Undefined type for 'else' branch in conditional")
	end select
	end subroutine eval_node_compile_default_else

	@ %def eval_node_compile_default_else
	@ If the logical expression is constant, we can simplify the conditional node
	by replacing it with the selected branch. Otherwise, we initialize a true
	branching.
	<<Eval trees: procedures>>=
	subroutine eval_node_create_conditional (en, en0, en1, en2, result_type)
	type(eval_node_t), pointer :: en, en0, en1, en2
	integer, intent(in) :: result_type
	if (en0%type == EN_CONSTANT) then
	if (en0%lval) then
	en => en1
	call eval_node_final_rec (en2)
	deallocate (en2)
	else
	en => en2
	call eval_node_final_rec (en1)
	deallocate (en1)
	end if
	else
	allocate (en)
	call eval_node_init_conditional (en, result_type, en0, en1, en2)
	end if
	end subroutine eval_node_create_conditional

	@ %def eval_node_create_conditional
	@ Return the numerical result type which should be used for the combination of
	the two result types.
	<<Eval trees: procedures>>=
	function major_result_type (t1, t2) result (t)
	integer :: t
	integer, intent(in) :: t1, t2
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT, V_REAL, V_CMPLX)
	t = t2
	case default
	call type_mismatch ()
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT)
	t = t1
	case (V_REAL, V_CMPLX)
	t = t2
	case default
	call type_mismatch ()
	end select
	case (V_CMPLX)
	select case (t2)
	case (V_INT, V_REAL, V_CMPLX)
	t = t1
	case default
	call type_mismatch ()
	end select
	case default
	if (t1 == t2) then
	t = t1
	else
	call type_mismatch ()
	end if
	end select
	contains
	subroutine type_mismatch ()
	call msg_bug ("Type mismatch in branches of a conditional expression")
	end subroutine type_mismatch
	end function major_result_type

	@ %def major_result_type
	@ Recursively insert conversion nodes where necessary.
	<<Eval trees: procedures>>=
	recursive subroutine conditional_insert_conversion_nodes (en, result_type)
	type(eval_node_t), intent(inout), target :: en
	integer, intent(in) :: result_type
	select case (result_type)
	case (V_INT, V_REAL, V_CMPLX)
	call insert_conversion_node (en%arg1, result_type)
	if (en%arg2%type == EN_CONDITIONAL) then
	call conditional_insert_conversion_nodes (en%arg2, result_type)
	else
	call insert_conversion_node (en%arg2, result_type)
	end if
	end select
	end subroutine conditional_insert_conversion_nodes

	@ %def conditional_insert_conversion_nodes
	@
	\subsubsection{Logical expressions}
	A logical expression consists of one or more singlet logical expressions
	concatenated by [[;]]. This is for allowing side-effects, only the last value
	is used.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_lexpr (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_term, pn_sequel, pn_arg
	type(eval_node_t), pointer :: en1, en2
	if (debug_active (D_MODEL_F)) then
	print *, "read lexpr"; call parse_node_write (pn)
	end if
	pn_term => parse_node_get_sub_ptr (pn, tag="lsinglet")
	call eval_node_compile_lsinglet (en, pn_term, var_list)
	pn_sequel => parse_node_get_next_ptr (pn_term, tag="lsequel")
	do while (associated (pn_sequel))
	pn_arg => parse_node_get_sub_ptr (pn_sequel, 2, tag="lsinglet")
	en1 => en
	call eval_node_compile_lsinglet (en2, pn_arg, var_list)
	allocate (en)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	call eval_node_init_log (en, ignore_first_ll (en1, en2))
	call eval_node_final_rec (en1)
	call eval_node_final_rec (en2)
	deallocate (en1, en2)
	else
	call eval_node_init_branch &
	(en, var_str ("lsequel"), V_LOG, en1, en2)
	call eval_node_set_op2_log (en, ignore_first_ll)
	end if
	pn_sequel => parse_node_get_next_ptr (pn_sequel)
	end do
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done lexpr"
	end if
	end subroutine eval_node_compile_lexpr

	@ %def eval_node_compile_lexpr
	@ A logical singlet expression consists of one or more logical terms
	concatenated by [[or]].
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_lsinglet (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_term, pn_alternative, pn_arg
	type(eval_node_t), pointer :: en1, en2
	if (debug_active (D_MODEL_F)) then
	print *, "read lsinglet"; call parse_node_write (pn)
	end if
	pn_term => parse_node_get_sub_ptr (pn, tag="lterm")
	call eval_node_compile_lterm (en, pn_term, var_list)
	pn_alternative => parse_node_get_next_ptr (pn_term, tag="alternative")
	do while (associated (pn_alternative))
	pn_arg => parse_node_get_sub_ptr (pn_alternative, 2, tag="lterm")
	en1 => en
	call eval_node_compile_lterm (en2, pn_arg, var_list)
	allocate (en)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	call eval_node_init_log (en, or_ll (en1, en2))
	call eval_node_final_rec (en1)
	call eval_node_final_rec (en2)
	deallocate (en1, en2)
	else
	call eval_node_init_branch &
	(en, var_str ("alternative"), V_LOG, en1, en2)
	call eval_node_set_op2_log (en, or_ll)
	end if
	pn_alternative => parse_node_get_next_ptr (pn_alternative)
	end do
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done lsinglet"
	end if
	end subroutine eval_node_compile_lsinglet

	@ %def eval_node_compile_lsinglet
	@ A logical term consists of one or more logical values
	concatenated by [[and]].
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_lterm (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_term, pn_coincidence, pn_arg
	type(eval_node_t), pointer :: en1, en2
	if (debug_active (D_MODEL_F)) then
	print *, "read lterm"; call parse_node_write (pn)
	end if
	pn_term => parse_node_get_sub_ptr (pn)
	call eval_node_compile_lvalue (en, pn_term, var_list)
	pn_coincidence => parse_node_get_next_ptr (pn_term, tag="coincidence")
	do while (associated (pn_coincidence))
	pn_arg => parse_node_get_sub_ptr (pn_coincidence, 2)
	en1 => en
	call eval_node_compile_lvalue (en2, pn_arg, var_list)
	allocate (en)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	call eval_node_init_log (en, and_ll (en1, en2))
	call eval_node_final_rec (en1)
	call eval_node_final_rec (en2)
	deallocate (en1, en2)
	else
	call eval_node_init_branch &
	(en, var_str ("coincidence"), V_LOG, en1, en2)
	call eval_node_set_op2_log (en, and_ll)
	end if
	pn_coincidence => parse_node_get_next_ptr (pn_coincidence)
	end do
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done lterm"
	end if
	end subroutine eval_node_compile_lterm

	@ %def eval_node_compile_lterm
	@ Logical variables are disabled, because they are confused with the
	l.h.s.\ of compared expressions.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_lvalue (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	if (debug_active (D_MODEL_F)) then
	print *, "read lvalue"; call parse_node_write (pn)
	end if
	select case (char (parse_node_get_rule_key (pn)))
	case ("true")
	allocate (en)
	call eval_node_init_log (en, .true.)
	case ("false")
	allocate (en)
	call eval_node_init_log (en, .false.)
	case ("negation")
	call eval_node_compile_negation (en, pn, var_list)
	case ("lvariable")
	call eval_node_compile_variable (en, pn, var_list, V_LOG)
	case ("lexpr")
	call eval_node_compile_lexpr (en, pn, var_list)
	case ("block_lexpr")
	call eval_node_compile_block_expr (en, pn, var_list, V_LOG)
	case ("conditional_lexpr")
	call eval_node_compile_conditional (en, pn, var_list, V_LOG)
	case ("compared_expr")
	call eval_node_compile_compared_expr (en, pn, var_list, V_REAL)
	case ("compared_sexpr")
	call eval_node_compile_compared_expr (en, pn, var_list, V_STR)
	case ("all_fun", "any_fun", "no_fun", "photon_isolation_fun")
	call eval_node_compile_log_function (en, pn, var_list)
	case ("record_cmd")
	call eval_node_compile_record_cmd (en, pn, var_list)
	case default
	call parse_node_mismatch &
	("true\|false\|negation\|lvariable\|" // &
	"lexpr\|block_lexpr\|conditional_lexpr\|" // &
	"compared_expr\|compared_sexpr\|logical_pexpr", pn)
	end select
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done lvalue"
	end if
	end subroutine eval_node_compile_lvalue

	@ %def eval_node_compile_lvalue
	@ A negation consists of the keyword [[not]] and a logical value.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_negation (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_arg
	type(eval_node_t), pointer :: en1
	if (debug_active (D_MODEL_F)) then
	print *, "read negation"; call parse_node_write (pn)
	end if
	pn_arg => parse_node_get_sub_ptr (pn, 2)
	call eval_node_compile_lvalue (en1, pn_arg, var_list)
	allocate (en)
	if (en1%type == EN_CONSTANT) then
	call eval_node_init_log (en, not_l (en1))
	call eval_node_final_rec (en1)
	deallocate (en1)
	else
	call eval_node_init_branch (en, var_str ("not"), V_LOG, en1)
	call eval_node_set_op1_log (en, not_l)
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done negation"
	end if
	end subroutine eval_node_compile_negation

	@ %def eval_node_compile_negation
	@
	\subsubsection{Comparisons}
	Up to the loop, this is easy. There is always at least one
	comparison. This is evaluated, and the result is the logical node
	[[en]]. If it is constant, we keep its second sub-node as [[en2]].
	(Thus, at the very end [[en2]] has to be deleted if [[en]] is (still)
	constant.)

	If there is another comparison, we first check if the first comparison
	was constant. In that case, there are two possibilities: (i) it was
	true. Then, its right-hand side is compared with the new right-hand
	side, and the result replaces the previous one which is deleted. (ii)
	it was false. In this case, the result of the whole comparison is
	false, and we can exit the loop without evaluating anything else.

	Now assume that the first comparison results in a valid branch, its
	second sub-node kept as [[en2]]. We first need a copy of this, which
	becomes the new left-hand side. If [[en2]] is constant, we make an
	identical constant node [[en1]]. Otherwise, we make [[en1]] an
	appropriate pointer node. Next, the first branch is saved as [[en0]]
	and we evaluate the comparison between [[en1]] and the a right-hand
	side. If this turns out to be constant, there are again two
	possibilities: (i) true, then we revert to the previous result. (ii)
	false, then the wh
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_compared_expr (en, pn, var_list, type)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	integer, intent(in) :: type
	type(parse_node_t), pointer :: pn_comparison, pn_expr1
	type(eval_node_t), pointer :: en0, en1, en2
	if (debug_active (D_MODEL_F)) then
	print *, "read comparison"; call parse_node_write (pn)
	end if
	select case (type)
	case (V_INT, V_REAL)
	pn_expr1 => parse_node_get_sub_ptr (pn, tag="expr")
	call eval_node_compile_expr (en1, pn_expr1, var_list)
	pn_comparison => parse_node_get_next_ptr (pn_expr1, tag="comparison")
	case (V_STR)
	pn_expr1 => parse_node_get_sub_ptr (pn, tag="sexpr")
	call eval_node_compile_sexpr (en1, pn_expr1, var_list)
	pn_comparison => parse_node_get_next_ptr (pn_expr1, tag="str_comparison")
	end select
	call eval_node_compile_comparison &
	(en, en1, en2, pn_comparison, var_list, type)
	pn_comparison => parse_node_get_next_ptr (pn_comparison)
	SCAN_FURTHER: do while (associated (pn_comparison))
	if (en%type == EN_CONSTANT) then
	if (en%lval) then
	en1 => en2
	call eval_node_final_rec (en); deallocate (en)
	call eval_node_compile_comparison &
	(en, en1, en2, pn_comparison, var_list, type)
	else
	exit SCAN_FURTHER
	end if
	else
	allocate (en1)
	if (en2%type == EN_CONSTANT) then
	select case (en2%result_type)
	case (V_INT); call eval_node_init_int (en1, en2%ival)
	case (V_REAL); call eval_node_init_real (en1, en2%rval)
	case (V_STR); call eval_node_init_string (en1, en2%sval)
	end select
	else
	select case (en2%result_type)
	case (V_INT); call eval_node_init_int_ptr &
	(en1, var_str ("(previous)"), en2%ival, en2%value_is_known)
	case (V_REAL); call eval_node_init_real_ptr &
	(en1, var_str ("(previous)"), en2%rval, en2%value_is_known)
	case (V_STR); call eval_node_init_string_ptr &
	(en1, var_str ("(previous)"), en2%sval, en2%value_is_known)
	end select
	end if
	en0 => en
	call eval_node_compile_comparison &
	(en, en1, en2, pn_comparison, var_list, type)
	if (en%type == EN_CONSTANT) then
	if (en%lval) then
	call eval_node_final_rec (en); deallocate (en)
	en => en0
	else
	call eval_node_final_rec (en0); deallocate (en0)
	exit SCAN_FURTHER
	end if
	else
	en1 => en
	allocate (en)
	call eval_node_init_branch (en, var_str ("and"), V_LOG, en0, en1)
	call eval_node_set_op2_log (en, and_ll)
	end if
	end if
	pn_comparison => parse_node_get_next_ptr (pn_comparison)
	end do SCAN_FURTHER
	if (en%type == EN_CONSTANT .and. associated (en2)) then
	call eval_node_final_rec (en2); deallocate (en2)
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done compared_expr"
	end if
	end subroutine eval_node_compile_compared_expr

	@ %dev eval_node_compile_compared_expr
	@ This takes two extra arguments: [[en1]], the left-hand-side of the
	comparison, is already allocated and evaluated. [[en2]] (the
	right-hand side) and [[en]] (the result) are allocated by the
	routine. [[pn]] is the parse node which contains the operator and the
	right-hand side as subnodes.

	If the result of the comparison is constant, [[en1]] is deleted but
	[[en2]] is kept, because it may be used in a subsequent comparison.
	[[en]] then becomes a constant. If the result is variable, [[en]]
	becomes a branch node which refers to [[en1]] and [[en2]].
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_comparison &
	(en, en1, en2, pn, var_list, type)
	type(eval_node_t), pointer :: en, en1, en2
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	integer, intent(in) :: type
	type(parse_node_t), pointer :: pn_op, pn_arg
	type(string_t) :: key
	integer :: t1, t2
	real(default), pointer :: tolerance_ptr
	pn_op => parse_node_get_sub_ptr (pn)
	key = parse_node_get_key (pn_op)
	select case (type)
	case (V_INT, V_REAL)
	pn_arg => parse_node_get_next_ptr (pn_op, tag="expr")
	call eval_node_compile_expr (en2, pn_arg, var_list)
	case (V_STR)
	pn_arg => parse_node_get_next_ptr (pn_op, tag="sexpr")
	call eval_node_compile_sexpr (en2, pn_arg, var_list)
	end select
	t1 = en1%result_type
	t2 = en2%result_type
	allocate (en)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	call var_list%get_rptr (var_str ("tolerance"), tolerance_ptr)
	en1%tolerance => tolerance_ptr
	select case (char (key))
	case ("<")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_lt_ii (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_ll_ir (en1, en2))
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_ll_ri (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_ll_rr (en1, en2))
	end select
	end select
	case (">")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_gt_ii (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_gg_ir (en1, en2))
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_gg_ri (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_gg_rr (en1, en2))
	end select
	end select
	case ("<=")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_le_ii (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_ls_ir (en1, en2))
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_ls_ri (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_ls_rr (en1, en2))
	end select
	end select
	case (">=")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_ge_ii (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_gs_ir (en1, en2))
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_gs_ri (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_gs_rr (en1, en2))
	end select
	end select
	case ("==")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_eq_ii (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_se_ir (en1, en2))
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_se_ri (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_se_rr (en1, en2))
	end select
	case (V_STR)
	select case (t2)
	case (V_STR); call eval_node_init_log (en, comp_eq_ss (en1, en2))
	end select
	end select
	case ("<>")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_ne_ii (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_ns_ir (en1, en2))
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_init_log (en, comp_ns_ri (en1, en2))
	case (V_REAL); call eval_node_init_log (en, comp_ns_rr (en1, en2))
	end select
	case (V_STR)
	select case (t2)
	case (V_STR); call eval_node_init_log (en, comp_ne_ss (en1, en2))
	end select
	end select
	end select
	call eval_node_final_rec (en1)
	deallocate (en1)
	else
	call eval_node_init_branch (en, key, V_LOG, en1, en2)
	select case (char (key))
	case ("<")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_lt_ii)
	case (V_REAL); call eval_node_set_op2_log (en, comp_ll_ir)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_ll_ri)
	case (V_REAL); call eval_node_set_op2_log (en, comp_ll_rr)
	end select
	end select
	case (">")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_gt_ii)
	case (V_REAL); call eval_node_set_op2_log (en, comp_gg_ir)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_gg_ri)
	case (V_REAL); call eval_node_set_op2_log (en, comp_gg_rr)
	end select
	end select
	case ("<=")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_le_ii)
	case (V_REAL); call eval_node_set_op2_log (en, comp_ls_ir)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_ls_ri)
	case (V_REAL); call eval_node_set_op2_log (en, comp_ls_rr)
	end select
	end select
	case (">=")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_ge_ii)
	case (V_REAL); call eval_node_set_op2_log (en, comp_gs_ir)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_gs_ri)
	case (V_REAL); call eval_node_set_op2_log (en, comp_gs_rr)
	end select
	end select
	case ("==")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_eq_ii)
	case (V_REAL); call eval_node_set_op2_log (en, comp_se_ir)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_se_ri)
	case (V_REAL); call eval_node_set_op2_log (en, comp_se_rr)
	end select
	case (V_STR)
	select case (t2)
	case (V_STR); call eval_node_set_op2_log (en, comp_eq_ss)
	end select
	end select
	case ("<>")
	select case (t1)
	case (V_INT)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_ne_ii)
	case (V_REAL); call eval_node_set_op2_log (en, comp_ns_ir)
	end select
	case (V_REAL)
	select case (t2)
	case (V_INT); call eval_node_set_op2_log (en, comp_ns_ri)
	case (V_REAL); call eval_node_set_op2_log (en, comp_ns_rr)
	end select
	case (V_STR)
	select case (t2)
	case (V_STR); call eval_node_set_op2_log (en, comp_ne_ss)
	end select
	end select
	end select
	call var_list%get_rptr (var_str ("tolerance"), tolerance_ptr)
	en1%tolerance => tolerance_ptr
	end if
	end subroutine eval_node_compile_comparison

	@ %def eval_node_compile_comparison
	@
	\subsubsection{Recording analysis data}
	The [[record]] command is actually a logical expression which always
	evaluates [[true]].
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_record_cmd (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_key, pn_tag, pn_arg
	type(parse_node_t), pointer :: pn_arg1, pn_arg2, pn_arg3, pn_arg4
	type(eval_node_t), pointer :: en0, en1, en2, en3, en4
	real(default), pointer :: event_weight
	if (debug_active (D_MODEL_F)) then
	print *, "read record_cmd"; call parse_node_write (pn)
	end if
	pn_key => parse_node_get_sub_ptr (pn)
	pn_tag => parse_node_get_next_ptr (pn_key)
	pn_arg => parse_node_get_next_ptr (pn_tag)
	select case (char (parse_node_get_key (pn_key)))
	case ("record")
	call var_list%get_rptr (var_str ("event_weight"), event_weight)
	case ("record_unweighted")
	event_weight => null ()
	case ("record_excess")
	call var_list%get_rptr (var_str ("event_excess"), event_weight)
	end select
	select case (char (parse_node_get_rule_key (pn_tag)))
	case ("analysis_id")
	allocate (en0)
	call eval_node_init_string (en0, parse_node_get_string (pn_tag))
	case default
	call eval_node_compile_sexpr (en0, pn_tag, var_list)
	end select
	allocate (en)
	if (associated (pn_arg)) then
	pn_arg1 => parse_node_get_sub_ptr (pn_arg)
	call eval_node_compile_expr (en1, pn_arg1, var_list)
	if (en1%result_type == V_INT) &
	call insert_conversion_node (en1, V_REAL)
	pn_arg2 => parse_node_get_next_ptr (pn_arg1)
	if (associated (pn_arg2)) then
	call eval_node_compile_expr (en2, pn_arg2, var_list)
	if (en2%result_type == V_INT) &
	call insert_conversion_node (en2, V_REAL)
	pn_arg3 => parse_node_get_next_ptr (pn_arg2)
	if (associated (pn_arg3)) then
	call eval_node_compile_expr (en3, pn_arg3, var_list)
	if (en3%result_type == V_INT) &
	call insert_conversion_node (en3, V_REAL)
	pn_arg4 => parse_node_get_next_ptr (pn_arg3)
	if (associated (pn_arg4)) then
	call eval_node_compile_expr (en4, pn_arg4, var_list)
	if (en4%result_type == V_INT) &
	call insert_conversion_node (en4, V_REAL)
	call eval_node_init_record_cmd &
	(en, event_weight, en0, en1, en2, en3, en4)
	else
	call eval_node_init_record_cmd &
	(en, event_weight, en0, en1, en2, en3)
	end if
	else
	call eval_node_init_record_cmd (en, event_weight, en0, en1, en2)
	end if
	else
	call eval_node_init_record_cmd (en, event_weight, en0, en1)
	end if
	else
	call eval_node_init_record_cmd (en, event_weight, en0)
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done record_cmd"
	end if
	end subroutine eval_node_compile_record_cmd

	@ %def eval_node_compile_record_cmd
	@
	\subsubsection{Particle-list expressions}
	A particle expression is a subevent or a concatenation of
	particle-list terms (using \verb\|join\|).
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_pexpr (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_pterm, pn_concatenation, pn_op, pn_arg
	type(eval_node_t), pointer :: en1, en2
	type(subevt_t) :: subevt
	if (debug_active (D_MODEL_F)) then
	print *, "read pexpr"; call parse_node_write (pn)
	end if
	pn_pterm => parse_node_get_sub_ptr (pn)
	call eval_node_compile_pterm (en, pn_pterm, var_list)
	pn_concatenation => &
	parse_node_get_next_ptr (pn_pterm, tag="pconcatenation")
	do while (associated (pn_concatenation))
	pn_op => parse_node_get_sub_ptr (pn_concatenation)
	pn_arg => parse_node_get_next_ptr (pn_op)
	en1 => en
	call eval_node_compile_pterm (en2, pn_arg, var_list)
	allocate (en)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	call subevt_join (subevt, en1%pval, en2%pval)
	call eval_node_init_subevt (en, subevt)
	call eval_node_final_rec (en1)
	call eval_node_final_rec (en2)
	deallocate (en1, en2)
	else
	call eval_node_init_branch &
	(en, var_str ("join"), V_SEV, en1, en2)
	call eval_node_set_op2_sev (en, join_pp)
	end if
	pn_concatenation => parse_node_get_next_ptr (pn_concatenation)
	end do
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done pexpr"
	end if
	end subroutine eval_node_compile_pexpr

	@ %def eval_node_compile_pexpr
	@ A particle term is a subevent or a combination of
	particle-list values (using \verb\|combine\|).
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_pterm (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_pvalue, pn_combination, pn_op, pn_arg
	type(eval_node_t), pointer :: en1, en2
	type(subevt_t) :: subevt
	if (debug_active (D_MODEL_F)) then
	print *, "read pterm"; call parse_node_write (pn)
	end if
	pn_pvalue => parse_node_get_sub_ptr (pn)
	call eval_node_compile_pvalue (en, pn_pvalue, var_list)
	pn_combination => &
	parse_node_get_next_ptr (pn_pvalue, tag="pcombination")
	do while (associated (pn_combination))
	pn_op => parse_node_get_sub_ptr (pn_combination)
	pn_arg => parse_node_get_next_ptr (pn_op)
	en1 => en
	call eval_node_compile_pvalue (en2, pn_arg, var_list)
	allocate (en)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	call subevt_combine (subevt, en1%pval, en2%pval)
	call eval_node_init_subevt (en, subevt)
	call eval_node_final_rec (en1)
	call eval_node_final_rec (en2)
	deallocate (en1, en2)
	else
	call eval_node_init_branch &
	(en, var_str ("combine"), V_SEV, en1, en2)
	call eval_node_set_op2_sev (en, combine_pp)
	end if
	pn_combination => parse_node_get_next_ptr (pn_combination)
	end do
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done pterm"
	end if
	end subroutine eval_node_compile_pterm

	@ %def eval_node_compile_pterm
	@ A particle-list value is a PDG-code array, a particle identifier, a
	variable, a (grouped) pexpr, a block pexpr, a conditional, or a
	particle-list function.

	The [[cexpr]] node is responsible for transforming a constant PDG-code
	array into a subevent. It takes the code array as its first
	argument, the event subevent as its second argument, and the
	requested particle type (incoming/outgoing) as its zero-th argument.
	The result is the list of particles in the event that match the code
	array.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_pvalue (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_prefix_cexpr
	type(eval_node_t), pointer :: en1, en2, en0
	type(string_t) :: key
	type(subevt_t), pointer :: evt_ptr
	logical, pointer :: known
	if (debug_active (D_MODEL_F)) then
	print *, "read pvalue"; call parse_node_write (pn)
	end if
	select case (char (parse_node_get_rule_key (pn)))
	case ("pexpr_src")
	call eval_node_compile_prefix_cexpr (en1, pn, var_list)
	allocate (en2)
	if (var_list%contains (var_str ("@evt"))) then
	call var_list%get_pptr (var_str ("@evt"), evt_ptr, known)
	call eval_node_init_subevt_ptr (en2, var_str ("@evt"), evt_ptr, known)
	allocate (en)
	call eval_node_init_branch &
	(en, var_str ("prt_selection"), V_SEV, en1, en2)
	call eval_node_set_op2_sev (en, select_pdg_ca)
	allocate (en0)
	pn_prefix_cexpr => parse_node_get_sub_ptr (pn)
	key = parse_node_get_rule_key (pn_prefix_cexpr)
	select case (char (key))
	case ("beam_prt")
	call eval_node_init_int (en0, PRT_BEAM)
	en%arg0 => en0
	case ("incoming_prt")
	call eval_node_init_int (en0, PRT_INCOMING)
	en%arg0 => en0
	case ("outgoing_prt")
	call eval_node_init_int (en0, PRT_OUTGOING)
	en%arg0 => en0
	case ("unspecified_prt")
	call eval_node_init_int (en0, PRT_OUTGOING)
	en%arg0 => en0
	end select
	else
	call parse_node_write (pn)
	call msg_bug (" Missing event data while compiling pvalue")
	end if
	case ("pvariable")
	call eval_node_compile_variable (en, pn, var_list, V_SEV)
	case ("pexpr")
	call eval_node_compile_pexpr (en, pn, var_list)
	case ("block_pexpr")
	call eval_node_compile_block_expr (en, pn, var_list, V_SEV)
	case ("conditional_pexpr")
	call eval_node_compile_conditional (en, pn, var_list, V_SEV)
	case ("join_fun", "combine_fun", "collect_fun", "cluster_fun", &
	"select_fun", "extract_fun", "sort_fun", "select_b_jet_fun", &
	"select_non_bjet_fun", "select_c_jet_fun", &
	"select_light_jet_fun", "photon_reco_fun")
	call eval_node_compile_prt_function (en, pn, var_list)
	case default
	call parse_node_mismatch &
	("prefix_cexpr\|pvariable\|" // &
	"grouped_pexpr\|block_pexpr\|conditional_pexpr\|" // &
	"prt_function", pn)
	end select
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done pvalue"
	end if
	end subroutine eval_node_compile_pvalue

	@ %def eval_node_compile_pvalue
	@
	\subsubsection{Particle functions}
	This combines the treatment of 'join', 'combine', 'collect', 'cluster',
	'select', and 'extract', as well as the functions for $b$, $c$ and
	light jet selection and photon recombnation which all have the same
	syntax. The one or two argument nodes are allocated. If there is a
	condition, the condition node is also allocated as a logical
	expression, for which the variable list is augmented by the
	appropriate (unary/binary) observables.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_prt_function (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_clause, pn_key, pn_cond, pn_args
	type(parse_node_t), pointer :: pn_arg0, pn_arg1, pn_arg2
	type(eval_node_t), pointer :: en0, en1, en2
	type(string_t) :: key
	if (debug_active (D_MODEL_F)) then
	print *, "read prt_function"; call parse_node_write (pn)
	end if
	pn_clause => parse_node_get_sub_ptr (pn)
	pn_key => parse_node_get_sub_ptr (pn_clause)
	pn_cond => parse_node_get_next_ptr (pn_key)
	if (associated (pn_cond)) &
	pn_arg0 => parse_node_get_sub_ptr (pn_cond, 2)
	pn_args => parse_node_get_next_ptr (pn_clause)
	pn_arg1 => parse_node_get_sub_ptr (pn_args)
	pn_arg2 => parse_node_get_next_ptr (pn_arg1)
	key = parse_node_get_key (pn_key)
	call eval_node_compile_pexpr (en1, pn_arg1, var_list)
	allocate (en)
	if (.not. associated (pn_arg2)) then
	select case (char (key))
	case ("collect")
	call eval_node_init_prt_fun_unary (en, en1, key, collect_p)
	case ("cluster")
	if (fastjet_available ()) then
	call fastjet_init ()
	else
	call msg_fatal &
	("'cluster' function requires FastJet, which is not enabled")
	end if
	en1%var_list => var_list
	call eval_node_init_prt_fun_unary (en, en1, key, cluster_p)
	call var_list%get_iptr (var_str ("jet_algorithm"), en1%jet_algorithm)
	call var_list%get_rptr (var_str ("jet_r"), en1%jet_r)
	call var_list%get_rptr (var_str ("jet_p"), en1%jet_p)
	call var_list%get_rptr (var_str ("jet_ycut"), en1%jet_ycut)
	call var_list%get_rptr (var_str ("jet_dcut"), en1%jet_dcut)
	case ("photon_recombination")
	en1%var_list => var_list
	call eval_node_init_prt_fun_unary &
	(en, en1, key, photon_recombination_p)
	call var_list%get_rptr (var_str ("photon_rec_r0"), en1%photon_rec_r0)
	case ("select")
	call eval_node_init_prt_fun_unary (en, en1, key, select_p)
	case ("extract")
	call eval_node_init_prt_fun_unary (en, en1, key, extract_p)
	case ("sort")
	call eval_node_init_prt_fun_unary (en, en1, key, sort_p)
	case ("select_b_jet")
	call eval_node_init_prt_fun_unary (en, en1, key, select_b_jet_p)
	case ("select_non_b_jet")
	call eval_node_init_prt_fun_unary (en, en1, key, select_non_b_jet_p)
	case ("select_c_jet")
	call eval_node_init_prt_fun_unary (en, en1, key, select_c_jet_p)
	case ("select_light_jet")
	call eval_node_init_prt_fun_unary (en, en1, key, select_light_jet_p)
	case default
	call msg_bug (" Unary particle function '" // char (key) // &
	"' undefined")
	end select
	else
	call eval_node_compile_pexpr (en2, pn_arg2, var_list)
	select case (char (key))
	case ("join")
	call eval_node_init_prt_fun_binary (en, en1, en2, key, join_pp)
	case ("combine")
	call eval_node_init_prt_fun_binary (en, en1, en2, key, combine_pp)
	case ("collect")
	call eval_node_init_prt_fun_binary (en, en1, en2, key, collect_pp)
	case ("select")
	call eval_node_init_prt_fun_binary (en, en1, en2, key, select_pp)
	case ("sort")
	call eval_node_init_prt_fun_binary (en, en1, en2, key, sort_pp)
	case default
	call msg_bug (" Binary particle function '" // char (key) // &
	"' undefined")
	end select
	end if
	if (associated (pn_cond)) then
	call eval_node_set_observables (en, var_list)
	select case (char (key))
	case ("extract", "sort")
	call eval_node_compile_expr (en0, pn_arg0, en%var_list)
	case default
	call eval_node_compile_lexpr (en0, pn_arg0, en%var_list)
	end select
	en%arg0 => en0
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done prt_function"
	end if
	end subroutine eval_node_compile_prt_function

	@ %def eval_node_compile_prt_function
	@ The [[eval]] expression is similar, but here the expression [[arg0]]
	is mandatory, and the whole thing evaluates to a numeric value. To
	guarantee initialization of variables defined on subevents instead of
	a single (namely the first) particle of a subevent, we make sure that
	[[en]] points to the subevent stored in [[en1]].
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_eval_function (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_key, pn_arg0, pn_args, pn_arg1, pn_arg2
	type(eval_node_t), pointer :: en0, en1, en2
	type(string_t) :: key
	if (debug_active (D_MODEL_F)) then
	print *, "read eval_function"; call parse_node_write (pn)
	end if
	pn_key => parse_node_get_sub_ptr (pn)
	pn_arg0 => parse_node_get_next_ptr (pn_key)
	pn_args => parse_node_get_next_ptr (pn_arg0)
	pn_arg1 => parse_node_get_sub_ptr (pn_args)
	pn_arg2 => parse_node_get_next_ptr (pn_arg1)
	key = parse_node_get_key (pn_key)
	call eval_node_compile_pexpr (en1, pn_arg1, var_list)
	allocate (en)
	if (.not. associated (pn_arg2)) then
	call eval_node_init_eval_fun_unary (en, en1, key)
	else
	call eval_node_compile_pexpr (en2, pn_arg2, var_list)
	call eval_node_init_eval_fun_binary (en, en1, en2, key)
	end if
	en%pval => en1%pval
	call eval_node_set_observables (en, var_list)
	call eval_node_compile_expr (en0, pn_arg0, en%var_list)
	if (en0%result_type == V_INT) &
	call insert_conversion_node (en0, V_REAL)
	if (en0%result_type /= V_REAL) &
	call msg_fatal (" 'eval' function does not result in real value")
	call eval_node_set_expr (en, en0)
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done eval_function"
	end if
	end subroutine eval_node_compile_eval_function

	@ %def eval_node_compile_eval_function
	@ Logical functions of subevents. For [[photon_isolation]] there is a
	conditional selection expression instead of a mandatory logical
	expression, so in the case of the absence of the selection we have to
	create a logical [[eval_node_t]] with value [[.true.]].
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_log_function (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_clause, pn_key, pn_str, pn_cond
	type(parse_node_t), pointer :: pn_arg0, pn_args, pn_arg1, pn_arg2
	type(eval_node_t), pointer :: en0, en1, en2
	type(string_t) :: key
	if (debug_active (D_MODEL_F)) then
	print *, "read log_function"; call parse_node_write (pn)
	end if
	select case (char (parse_node_get_rule_key (pn)))
	case ("all_fun", "any_fun", "no_fun")
	pn_key => parse_node_get_sub_ptr (pn)
	pn_arg0 => parse_node_get_next_ptr (pn_key)
	pn_args => parse_node_get_next_ptr (pn_arg0)
	case ("photon_isolation_fun")
	pn_clause => parse_node_get_sub_ptr (pn)
	pn_key => parse_node_get_sub_ptr (pn_clause)
	pn_cond => parse_node_get_next_ptr (pn_key)
	if (associated (pn_cond)) then
	pn_arg0 => parse_node_get_sub_ptr (pn_cond, 2)
	else
	pn_arg0 => null ()
	end if
	pn_args => parse_node_get_next_ptr (pn_clause)
	case default
	call parse_node_mismatch ("all_fun\|any_fun\|" // &
	"no_fun\|photon_isolation_fun", pn)
	end select
	pn_arg1 => parse_node_get_sub_ptr (pn_args)
	pn_arg2 => parse_node_get_next_ptr (pn_arg1)
	key = parse_node_get_key (pn_key)
	call eval_node_compile_pexpr (en1, pn_arg1, var_list)
	allocate (en)
	if (.not. associated (pn_arg2)) then
	select case (char (key))
	case ("all")
	call eval_node_init_log_fun_unary (en, en1, key, all_p)
	case ("any")
	call eval_node_init_log_fun_unary (en, en1, key, any_p)
	case ("no")
	call eval_node_init_log_fun_unary (en, en1, key, no_p)
	case default
	call msg_bug ("Unary logical particle function '" // char (key) // &
	"' undefined")
	end select
	else
	call eval_node_compile_pexpr (en2, pn_arg2, var_list)
	select case (char (key))
	case ("all")
	call eval_node_init_log_fun_binary (en, en1, en2, key, all_pp)
	case ("any")
	call eval_node_init_log_fun_binary (en, en1, en2, key, any_pp)
	case ("no")
	call eval_node_init_log_fun_binary (en, en1, en2, key, no_pp)
	case ("photon_isolation")
	en1%var_list => var_list
	call var_list%get_rptr (var_str ("photon_iso_eps"), en1%photon_iso_eps)
	call var_list%get_rptr (var_str ("photon_iso_n"), en1%photon_iso_n)
	call var_list%get_rptr (var_str ("photon_iso_r0"), en1%photon_iso_r0)
	call eval_node_init_log_fun_binary (en, en1, en2, key, photon_isolation_pp)
	case default
	call msg_bug ("Binary logical particle function '" // char (key) // &
	"' undefined")
	end select
	end if
	if (associated (pn_arg0)) then
	call eval_node_set_observables (en, var_list)
	select case (char (key))
	case ("all", "any", "no", "photon_isolation")
	call eval_node_compile_lexpr (en0, pn_arg0, en%var_list)
	case default
	call msg_bug ("Compiling logical particle function: missing mode")
	end select
	call eval_node_set_expr (en, en0, V_LOG)
	else
	select case (char (key))
	case ("photon_isolation")
	allocate (en0)
	call eval_node_init_log (en0, .true.)
	call eval_node_set_expr (en, en0, V_LOG)
	case default
	call msg_bug ("Only photon isolation can be called unconditionally")
	end select
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done log_function"
	end if
	end subroutine eval_node_compile_log_function

	@ %def eval_node_compile_log_function
	@ Count function of subevents.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_count_function (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_clause, pn_key, pn_cond, pn_args
	type(parse_node_t), pointer :: pn_arg0, pn_arg1, pn_arg2
	type(eval_node_t), pointer :: en0, en1, en2
	type(string_t) :: key
	if (debug_active (D_MODEL_F)) then
	print *, "read count_function"; call parse_node_write (pn)
	end if
	select case (char (parse_node_get_rule_key (pn)))
	case ("count_fun")
	pn_clause => parse_node_get_sub_ptr (pn)
	pn_key => parse_node_get_sub_ptr (pn_clause)
	pn_cond => parse_node_get_next_ptr (pn_key)
	if (associated (pn_cond)) then
	pn_arg0 => parse_node_get_sub_ptr (pn_cond, 2)
	else
	pn_arg0 => null ()
	end if
	pn_args => parse_node_get_next_ptr (pn_clause)
	end select
	pn_arg1 => parse_node_get_sub_ptr (pn_args)
	pn_arg2 => parse_node_get_next_ptr (pn_arg1)
	key = parse_node_get_key (pn_key)
	call eval_node_compile_pexpr (en1, pn_arg1, var_list)
	allocate (en)
	if (.not. associated (pn_arg2)) then
	select case (char (key))
	case ("count")
	call eval_node_init_int_fun_unary (en, en1, key, count_a)
	case default
	call msg_bug ("Unary subevent function '" // char (key) // &
	"' undefined")
	end select
	else
	call eval_node_compile_pexpr (en2, pn_arg2, var_list)
	select case (char (key))
	case ("count")
	call eval_node_init_int_fun_binary (en, en1, en2, key, count_pp)
	case default
	call msg_bug ("Binary subevent function '" // char (key) // &
	"' undefined")
	end select
	end if
	if (associated (pn_arg0)) then
	call eval_node_set_observables (en, var_list)
	select case (char (key))
	case ("count")
	call eval_node_compile_lexpr (en0, pn_arg0, en%var_list)
	call eval_node_set_expr (en, en0, V_INT)
	end select
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done count_function"
	end if
	end subroutine eval_node_compile_count_function

	@ %def eval_node_compile_count_function
	@ Numeric functions of subevents.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_numeric_function (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_key, pn_args
	type(parse_node_t), pointer :: pn_arg0, pn_arg1, pn_arg2
	type(eval_node_t), pointer :: en0, en1
	type(string_t) :: key
	if (debug_active (D_MODEL_F)) then
	print *, "read numeric_function"; call parse_node_write (pn)
	end if
	select case (char (parse_node_get_rule_key (pn)))
	case ("sum_fun", "prod_fun")
	if (debug_active (D_MODEL_F)) then
	print *, "read sum_fun"; call parse_node_write (pn)
	end if
	pn_key => parse_node_get_sub_ptr (pn)
	pn_arg0 => parse_node_get_next_ptr (pn_key)
	pn_args => parse_node_get_next_ptr (pn_arg0)
	end select
	pn_arg1 => parse_node_get_sub_ptr (pn_args)
	pn_arg2 => parse_node_get_next_ptr (pn_arg1)
	key = parse_node_get_key (pn_key)
	call eval_node_compile_pexpr (en1, pn_arg1, var_list)
	if (associated (pn_arg2)) then
	call msg_fatal ("The " // char (key) // &
	" function can only be used for unary observables.")
	end if
	allocate (en)
	select case (char (key))
	case ("sum")
	call eval_node_init_real_fun_cum (en, en1, key, sum_a)
	case ("prod")
	call eval_node_init_real_fun_cum (en, en1, key, prod_a)
	case default
	call msg_bug ("Unary subevent function '" // char (key) // &
	"' undefined")
	end select
	call eval_node_set_observables (en, var_list)
	call eval_node_compile_expr (en0, pn_arg0, en%var_list)
	if (en0%result_type == V_INT) &
	call insert_conversion_node (en0, V_REAL)
	call eval_node_set_expr (en, en0, V_REAL)
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done numeric_function"
	end if
	end subroutine eval_node_compile_numeric_function

	@ %def eval_node_compile_numeric_function
	@
	\subsubsection{PDG-code arrays}
	A PDG-code expression is (optionally) prefixed by [[beam]], [[incoming]], or
	[[outgoing]], a block, or a conditional. In any case, it evaluates to
	a constant.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_prefix_cexpr (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_avalue, pn_prt
	type(string_t) :: key
	if (debug_active (D_MODEL_F)) then
	print *, "read prefix_cexpr"; call parse_node_write (pn)
	end if
	pn_avalue => parse_node_get_sub_ptr (pn)
	key = parse_node_get_rule_key (pn_avalue)
	select case (char (key))
	case ("beam_prt")
	pn_prt => parse_node_get_sub_ptr (pn_avalue, 2)
	call eval_node_compile_cexpr (en, pn_prt, var_list)
	case ("incoming_prt")
	pn_prt => parse_node_get_sub_ptr (pn_avalue, 2)
	call eval_node_compile_cexpr (en, pn_prt, var_list)
	case ("outgoing_prt")
	pn_prt => parse_node_get_sub_ptr (pn_avalue, 2)
	call eval_node_compile_cexpr (en, pn_prt, var_list)
	case ("unspecified_prt")
	pn_prt => parse_node_get_sub_ptr (pn_avalue, 1)
	call eval_node_compile_cexpr (en, pn_prt, var_list)
	case default
	call parse_node_mismatch &
	("beam_prt\|incoming_prt\|outgoing_prt\|unspecified_prt", &
	pn_avalue)
	end select
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done prefix_cexpr"
	end if
	end subroutine eval_node_compile_prefix_cexpr

	@ %def eval_node_compile_prefix_cexpr
	@ A PDG array is a string of PDG code definitions (or aliases),
	concatenated by ':'. The code definitions may be variables which are
	not defined at compile time, so we have to allocate sub-nodes. This
	analogous to [[eval_node_compile_term]].
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_cexpr (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_prt, pn_concatenation
	type(eval_node_t), pointer :: en1, en2
	type(pdg_array_t) :: aval
	if (debug_active (D_MODEL_F)) then
	print *, "read cexpr"; call parse_node_write (pn)
	end if
	pn_prt => parse_node_get_sub_ptr (pn)
	call eval_node_compile_avalue (en, pn_prt, var_list)
	pn_concatenation => parse_node_get_next_ptr (pn_prt)
	do while (associated (pn_concatenation))
	pn_prt => parse_node_get_sub_ptr (pn_concatenation, 2)
	en1 => en
	call eval_node_compile_avalue (en2, pn_prt, var_list)
	allocate (en)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	call concat_cc (aval, en1, en2)
	call eval_node_init_pdg_array (en, aval)
	call eval_node_final_rec (en1)
	call eval_node_final_rec (en2)
	deallocate (en1, en2)
	else
	call eval_node_init_branch (en, var_str (":"), V_PDG, en1, en2)
	call eval_node_set_op2_pdg (en, concat_cc)
	end if
	pn_concatenation => parse_node_get_next_ptr (pn_concatenation)
	end do
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done cexpr"
	end if
	end subroutine eval_node_compile_cexpr

	@ %def eval_node_compile_cexpr
	@ Compile a PDG-code type value. It may be either an integer expression
	or a variable of type PDG array, optionally quoted.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_avalue (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	if (debug_active (D_MODEL_F)) then
	print *, "read avalue"; call parse_node_write (pn)
	end if
	select case (char (parse_node_get_rule_key (pn)))
	case ("pdg_code")
	call eval_node_compile_pdg_code (en, pn, var_list)
	case ("cvariable", "variable", "prt_name")
	call eval_node_compile_cvariable (en, pn, var_list)
	case ("cexpr")
	call eval_node_compile_cexpr (en, pn, var_list)
	case ("block_cexpr")
	call eval_node_compile_block_expr (en, pn, var_list, V_PDG)
	case ("conditional_cexpr")
	call eval_node_compile_conditional (en, pn, var_list, V_PDG)
	case default
	call parse_node_mismatch &
	("grouped_cexpr\|block_cexpr\|conditional_cexpr\|" // &
	"pdg_code\|cvariable\|prt_name", pn)
	end select
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done avalue"
	end if
	end subroutine eval_node_compile_avalue

	@ %def eval_node_compile_avalue
	@ Compile a PDG-code expression, which is the key [[PDG]] with an
	integer expression as argument. The procedure is analogous to
	[[eval_node_compile_unary_function]].
	<<Eval trees: procedures>>=
	subroutine eval_node_compile_pdg_code (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in), target :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_arg
	type(eval_node_t), pointer :: en1
	type(string_t) :: key
	type(pdg_array_t) :: aval
	integer :: t
	if (debug_active (D_MODEL_F)) then
	print *, "read PDG code"; call parse_node_write (pn)
	end if
	pn_arg => parse_node_get_sub_ptr (pn, 2)
	call eval_node_compile_expr &
	(en1, parse_node_get_sub_ptr (pn_arg, tag="expr"), var_list)
	t = en1%result_type
	allocate (en)
	key = "PDG"
	if (en1%type == EN_CONSTANT) then
	select case (t)
	case (V_INT)
	call pdg_i (aval, en1)
	call eval_node_init_pdg_array (en, aval)
	case default; call eval_type_error (pn, char (key), t)
	end select
	call eval_node_final_rec (en1)
	deallocate (en1)
	else
	select case (t)
	case (V_INT); call eval_node_set_op1_pdg (en, pdg_i)
	case default; call eval_type_error (pn, char (key), t)
	end select
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done function"
	end if
	end subroutine eval_node_compile_pdg_code

	@ %def eval_node_compile_pdg_code
	@ This is entirely analogous to [[eval_node_compile_variable]].
	However, PDG-array variables occur in different contexts.

	To avoid name clashes between PDG-array variables and ordinary
	variables, we prepend a character ([[*]]). This is not visible to the
	user.
	<<Eval trees: procedures>>=
	subroutine eval_node_compile_cvariable (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in), target :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_name
	type(string_t) :: var_name
	type(pdg_array_t), pointer :: aptr
	type(pdg_array_t), target, save :: no_aval
	logical, pointer :: known
	logical, target, save :: unknown = .false.
	if (debug_active (D_MODEL_F)) then
	print *, "read cvariable"; call parse_node_write (pn)
	end if
	pn_name => pn
	var_name = parse_node_get_string (pn_name)
	allocate (en)
	if (var_list%contains (var_name)) then
	call var_list%get_aptr (var_name, aptr, known)
	call eval_node_init_pdg_array_ptr (en, var_name, aptr, known)
	else
	call parse_node_write (pn)
	call msg_error ("This PDG-array variable is undefined at this point")
	call eval_node_init_pdg_array_ptr (en, var_name, no_aval, unknown)
	end if
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done cvariable"
	end if
	end subroutine eval_node_compile_cvariable

	@ %def eval_node_compile_cvariable
	@
	\subsubsection{String expressions}
	A string expression is either a string value or a concatenation of
	string values.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_sexpr (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_svalue, pn_concatenation, pn_op, pn_arg
	type(eval_node_t), pointer :: en1, en2
	type(string_t) :: string
	if (debug_active (D_MODEL_F)) then
	print *, "read sexpr"; call parse_node_write (pn)
	end if
	pn_svalue => parse_node_get_sub_ptr (pn)
	call eval_node_compile_svalue (en, pn_svalue, var_list)
	pn_concatenation => &
	parse_node_get_next_ptr (pn_svalue, tag="str_concatenation")
	do while (associated (pn_concatenation))
	pn_op => parse_node_get_sub_ptr (pn_concatenation)
	pn_arg => parse_node_get_next_ptr (pn_op)
	en1 => en
	call eval_node_compile_svalue (en2, pn_arg, var_list)
	allocate (en)
	if (en1%type == EN_CONSTANT .and. en2%type == EN_CONSTANT) then
	call concat_ss (string, en1, en2)
	call eval_node_init_string (en, string)
	call eval_node_final_rec (en1)
	call eval_node_final_rec (en2)
	deallocate (en1, en2)
	else
	call eval_node_init_branch &
	(en, var_str ("concat"), V_STR, en1, en2)
	call eval_node_set_op2_str (en, concat_ss)
	end if
	pn_concatenation => parse_node_get_next_ptr (pn_concatenation)
	end do
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done sexpr"
	end if
	end subroutine eval_node_compile_sexpr

	@ %def eval_node_compile_sexpr
	@ A string value is a string literal, a
	variable, a (grouped) sexpr, a block sexpr, or a conditional.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_svalue (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	if (debug_active (D_MODEL_F)) then
	print *, "read svalue"; call parse_node_write (pn)
	end if
	select case (char (parse_node_get_rule_key (pn)))
	case ("svariable")
	call eval_node_compile_variable (en, pn, var_list, V_STR)
	case ("sexpr")
	call eval_node_compile_sexpr (en, pn, var_list)
	case ("block_sexpr")
	call eval_node_compile_block_expr (en, pn, var_list, V_STR)
	case ("conditional_sexpr")
	call eval_node_compile_conditional (en, pn, var_list, V_STR)
	case ("sprintf_fun")
	call eval_node_compile_sprintf (en, pn, var_list)
	case ("string_literal")
	allocate (en)
	call eval_node_init_string (en, parse_node_get_string (pn))
	case default
	call parse_node_mismatch &
	("svariable\|" // &
	"grouped_sexpr\|block_sexpr\|conditional_sexpr\|" // &
	"string_function\|string_literal", pn)
	end select
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done svalue"
	end if
	end subroutine eval_node_compile_svalue

	@ %def eval_node_compile_svalue
	@ There is currently one string function, [[sprintf]]. For
	[[sprintf]], the first argument (no brackets) is the format string, the
	optional arguments in brackets are the expressions or variables to be
	formatted.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_compile_sprintf (en, pn, var_list)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_clause, pn_key, pn_args
	type(parse_node_t), pointer :: pn_arg0
	type(eval_node_t), pointer :: en0, en1
	integer :: n_args
	type(string_t) :: key
	if (debug_active (D_MODEL_F)) then
	print *, "read sprintf_fun"; call parse_node_write (pn)
	end if
	pn_clause => parse_node_get_sub_ptr (pn)
	pn_key => parse_node_get_sub_ptr (pn_clause)
	pn_arg0 => parse_node_get_next_ptr (pn_key)
	pn_args => parse_node_get_next_ptr (pn_clause)
	call eval_node_compile_sexpr (en0, pn_arg0, var_list)
	if (associated (pn_args)) then
	call eval_node_compile_sprintf_args (en1, pn_args, var_list, n_args)
	else
	n_args = 0
	en1 => null ()
	end if
	allocate (en)
	key = parse_node_get_key (pn_key)
	call eval_node_init_format_string (en, en0, en1, key, n_args)
	if (debug_active (D_MODEL_F)) then
	call eval_node_write (en)
	print *, "done sprintf_fun"
	end if
	end subroutine eval_node_compile_sprintf

	@ %def eval_node_compile_sprintf
	<<Eval trees: procedures>>=
	subroutine eval_node_compile_sprintf_args (en, pn, var_list, n_args)
	type(eval_node_t), pointer :: en
	type(parse_node_t), intent(in) :: pn
	type(var_list_t), intent(in), target :: var_list
	integer, intent(out) :: n_args
	type(parse_node_t), pointer :: pn_arg
	integer :: i
	type(eval_node_t), pointer :: en1, en2
	n_args = parse_node_get_n_sub (pn)
	en => null ()
	do i = n_args, 1, -1
	pn_arg => parse_node_get_sub_ptr (pn, i)
	select case (char (parse_node_get_rule_key (pn_arg)))
	case ("lvariable")
	call eval_node_compile_variable (en1, pn_arg, var_list, V_LOG)
	case ("svariable")
	call eval_node_compile_variable (en1, pn_arg, var_list, V_STR)
	case ("expr")
	call eval_node_compile_expr (en1, pn_arg, var_list)
	case default
	call parse_node_mismatch ("variable\|svariable\|lvariable\|expr", pn_arg)
	end select
	if (associated (en)) then
	en2 => en
	allocate (en)
	call eval_node_init_branch &
	(en, var_str ("sprintf_arg"), V_NONE, en1, en2)
	else
	allocate (en)
	call eval_node_init_branch &
	(en, var_str ("sprintf_arg"), V_NONE, en1)
	end if
	end do
	end subroutine eval_node_compile_sprintf_args

	@ %def eval_node_compile_sprintf_args
	@ Evaluation. We allocate the argument list and apply the Fortran wrapper for
	the [[sprintf]] function.
	<<Eval trees: procedures>>=
	subroutine evaluate_sprintf (string, n_args, en_fmt, en_arg)
	type(string_t), intent(out) :: string
	integer, intent(in) :: n_args
	type(eval_node_t), pointer :: en_fmt
	type(eval_node_t), intent(in), optional, target :: en_arg
	type(eval_node_t), pointer :: en_branch, en_var
	type(sprintf_arg_t), dimension(:), allocatable :: arg
	type(string_t) :: fmt
	logical :: autoformat
	integer :: i, j, sprintf_argc
	autoformat = .not. associated (en_fmt)
	if (autoformat) fmt = ""
	if (present (en_arg)) then
	sprintf_argc = 0
	en_branch => en_arg
	do i = 1, n_args
	select case (en_branch%arg1%result_type)
	case (V_CMPLX); sprintf_argc = sprintf_argc + 2
	case default ; sprintf_argc = sprintf_argc + 1
	end select
	en_branch => en_branch%arg2
	end do
	allocate (arg (sprintf_argc))
	j = 1
	en_branch => en_arg
	do i = 1, n_args
	en_var => en_branch%arg1
	select case (en_var%result_type)
	case (V_LOG)
	call sprintf_arg_init (arg(j), en_var%lval)
	if (autoformat) fmt = fmt // "%s "
	case (V_INT);
	call sprintf_arg_init (arg(j), en_var%ival)
	if (autoformat) fmt = fmt // "%i "
	case (V_REAL);
	call sprintf_arg_init (arg(j), en_var%rval)
	if (autoformat) fmt = fmt // "%g "
	case (V_STR)
	call sprintf_arg_init (arg(j), en_var%sval)
	if (autoformat) fmt = fmt // "%s "
	case (V_CMPLX)
	call sprintf_arg_init (arg(j), real (en_var%cval, default))
	j = j + 1
	call sprintf_arg_init (arg(j), aimag (en_var%cval))
	if (autoformat) fmt = fmt // "(%g + %g * I) "
	case default
	call eval_node_write (en_var)
	call msg_error ("sprintf is implemented " &
	// "for logical, integer, real, and string values only")
	end select
	j = j + 1
	en_branch => en_branch%arg2
	end do
	else
	allocate (arg(0))
	end if
	if (autoformat) then
	string = sprintf (trim (fmt), arg)
	else
	string = sprintf (en_fmt%sval, arg)
	end if
	end subroutine evaluate_sprintf

	@ %def evaluate_sprintf
	@
	\subsection{Auxiliary functions for the compiler}
	Issue an error that the current node could not be compiled because of
	type mismatch:
	<<Eval trees: procedures>>=
	subroutine eval_type_error (pn, string, t)
	type(parse_node_t), intent(in) :: pn
	character(*), intent(in) :: string
	integer, intent(in) :: t
	type(string_t) :: type
	select case (t)
	case (V_NONE); type = "(none)"
	case (V_LOG); type = "'logical'"
	case (V_INT); type = "'integer'"
	case (V_REAL); type = "'real'"
	case (V_CMPLX); type = "'complex'"
	case default; type = "(unknown)"
	end select
	call parse_node_write (pn)
	call msg_fatal (" The " // string // &
	" operation is not defined for the given argument type " // &
	char (type))
	end subroutine eval_type_error

	@ %def eval_type_error
	@
	If two numerics are combined, the result is integer if both
	arguments are integer, if one is integer and the other real or both
	are real, than its argument is real, otherwise complex.
	<<Eval trees: procedures>>=
	function numeric_result_type (t1, t2) result (t)
	integer, intent(in) :: t1, t2
	integer :: t
	if (t1 == V_INT .and. t2 == V_INT) then
	t = V_INT
	else if (t1 == V_INT .and. t2 == V_REAL) then
	t = V_REAL
	else if (t1 == V_REAL .and. t2 == V_INT) then
	t = V_REAL
	else if (t1 == V_REAL .and. t2 == V_REAL) then
	t = V_REAL
	else
	t = V_CMPLX
	end if
	end function numeric_result_type

	@ %def numeric_type
	@
	\subsection{Evaluation}
	Evaluation is done recursively. For leaf nodes nothing is to be done.

	Evaluating particle-list functions: First, we evaluate the particle
	lists. If a condition is present, we assign the particle pointers of
	the condition node to the allocated particle entries in the parent
	node, keeping in mind that the observables in the variable stack used
	for the evaluation of the condition also contain pointers to these
	entries. Then, the assigned procedure is evaluated, which sets the
	subevent in the parent node. If required, the procedure
	evaluates the condition node once for each (pair of) particles to
	determine the result.
	<<Eval trees: procedures>>=
	recursive subroutine eval_node_evaluate (en)
	type(eval_node_t), intent(inout) :: en
	logical :: exist
	select case (en%type)
	case (EN_UNARY)
	if (associated (en%arg1)) then
	call eval_node_evaluate (en%arg1)
	en%value_is_known = en%arg1%value_is_known
	else
	en%value_is_known = .false.
	end if
	if (en%value_is_known) then
	select case (en%result_type)
	case (V_LOG); en%lval = en%op1_log (en%arg1)
	case (V_INT); en%ival = en%op1_int (en%arg1)
	case (V_REAL); en%rval = en%op1_real (en%arg1)
	case (V_CMPLX); en%cval = en%op1_cmplx (en%arg1)
	case (V_PDG);
	call en%op1_pdg (en%aval, en%arg1)
	case (V_SEV)
	if (associated (en%arg0)) then
	call en%op1_sev (en%pval, en%arg1, en%arg0)
	else
	call en%op1_sev (en%pval, en%arg1)
	end if
	case (V_STR)
	call en%op1_str (en%sval, en%arg1)
	end select
	end if
	case (EN_BINARY)
	if (associated (en%arg1) .and. associated (en%arg2)) then
	call eval_node_evaluate (en%arg1)
	call eval_node_evaluate (en%arg2)
	en%value_is_known = &
	en%arg1%value_is_known .and. en%arg2%value_is_known
	else
	en%value_is_known = .false.
	end if
	if (en%value_is_known) then
	select case (en%result_type)
	case (V_LOG); en%lval = en%op2_log (en%arg1, en%arg2)
	case (V_INT); en%ival = en%op2_int (en%arg1, en%arg2)
	case (V_REAL); en%rval = en%op2_real (en%arg1, en%arg2)
	case (V_CMPLX); en%cval = en%op2_cmplx (en%arg1, en%arg2)
	case (V_PDG)
	call en%op2_pdg (en%aval, en%arg1, en%arg2)
	case (V_SEV)
	if (associated (en%arg0)) then
	call en%op2_sev (en%pval, en%arg1, en%arg2, en%arg0)
	else
	call en%op2_sev (en%pval, en%arg1, en%arg2)
	end if
	case (V_STR)
	call en%op2_str (en%sval, en%arg1, en%arg2)
	end select
	end if
	case (EN_BLOCK)
	if (associated (en%arg1) .and. associated (en%arg0)) then
	call eval_node_evaluate (en%arg1)
	call eval_node_evaluate (en%arg0)
	en%value_is_known = en%arg0%value_is_known
	else
	en%value_is_known = .false.
	end if
	if (en%value_is_known) then
	select case (en%result_type)
	case (V_LOG); en%lval = en%arg0%lval
	case (V_INT); en%ival = en%arg0%ival
	case (V_REAL); en%rval = en%arg0%rval
	case (V_CMPLX); en%cval = en%arg0%cval
	case (V_PDG); en%aval = en%arg0%aval
	case (V_SEV); en%pval = en%arg0%pval
	case (V_STR); en%sval = en%arg0%sval
	end select
	end if
	case (EN_CONDITIONAL)
	if (associated (en%arg0)) then
	call eval_node_evaluate (en%arg0)
	en%value_is_known = en%arg0%value_is_known
	else
	en%value_is_known = .false.
	end if
	if (en%arg0%value_is_known) then
	if (en%arg0%lval) then
	call eval_node_evaluate (en%arg1)
	en%value_is_known = en%arg1%value_is_known
	if (en%value_is_known) then
	select case (en%result_type)
	case (V_LOG); en%lval = en%arg1%lval
	case (V_INT); en%ival = en%arg1%ival
	case (V_REAL); en%rval = en%arg1%rval
	case (V_CMPLX); en%cval = en%arg1%cval
	case (V_PDG); en%aval = en%arg1%aval
	case (V_SEV); en%pval = en%arg1%pval
	case (V_STR); en%sval = en%arg1%sval
	end select
	end if
	else
	call eval_node_evaluate (en%arg2)
	en%value_is_known = en%arg2%value_is_known
	if (en%value_is_known) then
	select case (en%result_type)
	case (V_LOG); en%lval = en%arg2%lval
	case (V_INT); en%ival = en%arg2%ival
	case (V_REAL); en%rval = en%arg2%rval
	case (V_CMPLX); en%cval = en%arg2%cval
	case (V_PDG); en%aval = en%arg2%aval
	case (V_SEV); en%pval = en%arg2%pval
	case (V_STR); en%sval = en%arg2%sval
	end select
	end if
	end if
	end if
	case (EN_RECORD_CMD)
	exist = .true.
	en%lval = .false.
	call eval_node_evaluate (en%arg0)
	if (en%arg0%value_is_known) then
	if (associated (en%arg1)) then
	call eval_node_evaluate (en%arg1)
	if (en%arg1%value_is_known) then
	if (associated (en%arg2)) then
	call eval_node_evaluate (en%arg2)
	if (en%arg2%value_is_known) then
	if (associated (en%arg3)) then
	call eval_node_evaluate (en%arg3)
	if (en%arg3%value_is_known) then
	if (associated (en%arg4)) then
	call eval_node_evaluate (en%arg4)
	if (en%arg4%value_is_known) then
	if (associated (en%rval)) then
	call analysis_record_data (en%arg0%sval, &
	en%arg1%rval, en%arg2%rval, &
	en%arg3%rval, en%arg4%rval, &
	weight=en%rval, exist=exist, &
	success=en%lval)
	else
	call analysis_record_data (en%arg0%sval, &
	en%arg1%rval, en%arg2%rval, &
	en%arg3%rval, en%arg4%rval, &
	exist=exist, success=en%lval)
	end if
	end if
	else
	if (associated (en%rval)) then
	call analysis_record_data (en%arg0%sval, &
	en%arg1%rval, en%arg2%rval, &
	en%arg3%rval, &
	weight=en%rval, exist=exist, &
	success=en%lval)
	else
	call analysis_record_data (en%arg0%sval, &
	en%arg1%rval, en%arg2%rval, &
	en%arg3%rval, &
	exist=exist, success=en%lval)
	end if
	end if
	end if
	else
	if (associated (en%rval)) then
	call analysis_record_data (en%arg0%sval, &
	en%arg1%rval, en%arg2%rval, &
	weight=en%rval, exist=exist, &
	success=en%lval)
	else
	call analysis_record_data (en%arg0%sval, &
	en%arg1%rval, en%arg2%rval, &
	exist=exist, success=en%lval)
	end if
	end if
	end if
	else
	if (associated (en%rval)) then
	call analysis_record_data (en%arg0%sval, &
	en%arg1%rval, &
	weight=en%rval, exist=exist, success=en%lval)
	else
	call analysis_record_data (en%arg0%sval, &
	en%arg1%rval, &
	exist=exist, success=en%lval)
	end if
	end if
	end if
	else
	if (associated (en%rval)) then
	call analysis_record_data (en%arg0%sval, 1._default, &
	weight=en%rval, exist=exist, success=en%lval)
	else
	call analysis_record_data (en%arg0%sval, 1._default, &
	exist=exist, success=en%lval)
	end if
	end if
	if (.not. exist) then
	call msg_error ("Analysis object '" // char (en%arg0%sval) &
	// "' is undefined")
	en%arg0%value_is_known = .false.
	end if
	end if
	case (EN_OBS1_INT)
	en%ival = en%obs1_int (en%prt1)
	en%value_is_known = .true.
	case (EN_OBS2_INT)
	en%ival = en%obs2_int (en%prt1, en%prt2)
	en%value_is_known = .true.
	case (EN_OBSEV_INT)
	en%ival = en%obsev_int (en%pval)
	en%value_is_known = .true.
	case (EN_OBS1_REAL)
	en%rval = en%obs1_real (en%prt1)
	en%value_is_known = .true.
	case (EN_OBS2_REAL)
	en%rval = en%obs2_real (en%prt1, en%prt2)
	en%value_is_known = .true.
	case (EN_OBSEV_REAL)
	en%rval = en%obsev_real (en%pval)
	en%value_is_known = .true.
	case (EN_PRT_FUN_UNARY)
	call eval_node_evaluate (en%arg1)
	en%value_is_known = en%arg1%value_is_known
	if (en%value_is_known) then
	if (associated (en%arg0)) then
	en%arg0%index => en%index
	en%arg0%prt1 => en%prt1
	call en%op1_sev (en%pval, en%arg1, en%arg0)
	else
	call en%op1_sev (en%pval, en%arg1)
	end if
	end if
	case (EN_PRT_FUN_BINARY)
	call eval_node_evaluate (en%arg1)
	call eval_node_evaluate (en%arg2)
	en%value_is_known = &
	en%arg1%value_is_known .and. en%arg2%value_is_known
	if (en%value_is_known) then
	if (associated (en%arg0)) then
	en%arg0%index => en%index
	en%arg0%prt1 => en%prt1
	en%arg0%prt2 => en%prt2
	call en%op2_sev (en%pval, en%arg1, en%arg2, en%arg0)
	else
	call en%op2_sev (en%pval, en%arg1, en%arg2)
	end if
	end if
	case (EN_EVAL_FUN_UNARY)
	call eval_node_evaluate (en%arg1)
	en%value_is_known = en%arg1%pval%is_nonempty ()
	if (en%value_is_known) then
	en%arg0%index => en%index
	en%index = 1
	en%arg0%prt1 => en%prt1
	en%prt1 = en%arg1%pval%get_prt (1)
	call eval_node_evaluate (en%arg0)
	en%rval = en%arg0%rval
	end if
	case (EN_EVAL_FUN_BINARY)
	call eval_node_evaluate (en%arg1)
	call eval_node_evaluate (en%arg2)
	en%value_is_known = &
	en%arg1%pval%is_nonempty () .and. en%arg2%pval%is_nonempty ()
	if (en%value_is_known) then
	en%arg0%index => en%index
	en%arg0%prt1 => en%prt1
	en%arg0%prt2 => en%prt2
	en%index = 1
	call eval_pp (en%arg1, en%arg2, en%arg0, en%rval, en%value_is_known)
	end if
	case (EN_LOG_FUN_UNARY)
	call eval_node_evaluate (en%arg1)
	en%value_is_known = .true.
	if (en%value_is_known) then
	en%arg0%index => en%index
	en%arg0%prt1 => en%prt1
	en%lval = en%op1_cut (en%arg1, en%arg0)
	end if
	case (EN_LOG_FUN_BINARY)
	call eval_node_evaluate (en%arg1)
	call eval_node_evaluate (en%arg2)
	en%value_is_known = .true.
	if (en%value_is_known) then
	en%arg0%index => en%index
	en%arg0%prt1 => en%prt1
	en%arg0%prt2 => en%prt2
	en%lval = en%op2_cut (en%arg1, en%arg2, en%arg0)
	end if
	case (EN_INT_FUN_UNARY)
	call eval_node_evaluate (en%arg1)
	en%value_is_known = en%arg1%value_is_known
	if (en%value_is_known) then
	if (associated (en%arg0)) then
	en%arg0%index => en%index
	en%arg0%prt1 => en%prt1
	call en%op1_evi (en%ival, en%arg1, en%arg0)
	else
	call en%op1_evi (en%ival, en%arg1)
	end if
	end if
	case (EN_INT_FUN_BINARY)
	call eval_node_evaluate (en%arg1)
	call eval_node_evaluate (en%arg2)
	en%value_is_known = &
	en%arg1%value_is_known .and. &
	en%arg2%value_is_known
	if (en%value_is_known) then
	if (associated (en%arg0)) then
	en%arg0%index => en%index
	en%arg0%prt1 => en%prt1
	en%arg0%prt2 => en%prt2
	call en%op2_evi (en%ival, en%arg1, en%arg2, en%arg0)
	else
	call en%op2_evi (en%ival, en%arg1, en%arg2)
	end if
	end if
	case (EN_REAL_FUN_UNARY)
	call eval_node_evaluate (en%arg1)
	en%value_is_known = en%arg1%value_is_known
	if (en%value_is_known) then
	if (associated (en%arg0)) then
	en%arg0%index => en%index
	en%arg0%prt1 => en%prt1
	call en%op1_evr (en%rval, en%arg1, en%arg0)
	else
	call en%op1_evr (en%rval, en%arg1)
	end if
	end if
	case (EN_REAL_FUN_BINARY)
	call eval_node_evaluate (en%arg1)
	call eval_node_evaluate (en%arg2)
	en%value_is_known = &
	en%arg1%value_is_known .and. &
	en%arg2%value_is_known
	if (en%value_is_known) then
	if (associated (en%arg0)) then
	en%arg0%index => en%index
	en%arg0%prt1 => en%prt1
	en%arg0%prt2 => en%prt2
	call en%op2_evr (en%rval, en%arg1, en%arg2, en%arg0)
	else
	call en%op2_evr (en%rval, en%arg1, en%arg2)
	end if
	end if
	case (EN_REAL_FUN_CUM)
	call eval_node_evaluate (en%arg1)
	en%value_is_known = .true.
	if (en%value_is_known) then
	en%arg0%index => en%index
	en%arg0%prt1 => en%prt1
	en%rval = en%opcum_evr (en%arg1, en%arg0)
	end if
	case (EN_FORMAT_STR)
	if (associated (en%arg0)) then
	call eval_node_evaluate (en%arg0)
	en%value_is_known = en%arg0%value_is_known
	else
	en%value_is_known = .true.
	end if
	if (associated (en%arg1)) then
	call eval_node_evaluate (en%arg1)
	en%value_is_known = &
	en%value_is_known .and. en%arg1%value_is_known
	if (en%value_is_known) then
	call evaluate_sprintf (en%sval, en%ival, en%arg0, en%arg1)
	end if
	else
	if (en%value_is_known) then
	call evaluate_sprintf (en%sval, en%ival, en%arg0)
	end if
	end if
	end select
	if (debug2_active (D_MODEL_F)) then
	print *, "eval_node_evaluate"
	call eval_node_write (en)
	end if
	end subroutine eval_node_evaluate

	@ %def eval_node_evaluate
	@
	\subsubsection{Test method}
	This is called from a unit test: initialize a particular observable.
	<<Eval trees: eval node: TBP>>=
	procedure :: test_obs => eval_node_test_obs
	<<Eval trees: sub interfaces>>=
	module subroutine eval_node_test_obs (node, var_list, var_name)
	class(eval_node_t), intent(inout) :: node
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: var_name
	end subroutine eval_node_test_obs
	<<Eval trees: procedures>>=
	module subroutine eval_node_test_obs (node, var_list, var_name)
	class(eval_node_t), intent(inout) :: node
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: var_name
	procedure(obs_unary_int), pointer :: obs1_iptr
	type(prt_t), pointer :: p1
	call var_list%get_obs1_iptr (var_name, obs1_iptr, p1)
	call eval_node_init_obs1_int_ptr (node, var_name, obs1_iptr, p1)
	end subroutine eval_node_test_obs

	@ %def eval_node_test_obs
	@
	\subsection{Evaluation syntax}
	We have two different flavors of the syntax: with and without particles.
	<<Eval trees: public>>=
	public :: syntax_expr
	public :: syntax_pexpr
	<<Eval trees: variables>>=
	type(syntax_t), target, save :: syntax_expr
	type(syntax_t), target, save :: syntax_pexpr

	@ %def syntax_expr syntax_pexpr
	@ These are for testing only and may be removed:
	<<Eval trees: public>>=
	public :: syntax_expr_init
	public :: syntax_pexpr_init
	<<Eval trees: sub interfaces>>=
	module subroutine syntax_expr_init ()
	end subroutine syntax_expr_init
	module subroutine syntax_pexpr_init ()
	end subroutine syntax_pexpr_init
	<<Eval trees: procedures>>=
	module subroutine syntax_expr_init ()
	type(ifile_t) :: ifile
	call define_expr_syntax (ifile, particles=.false., analysis=.false.)
	call syntax_init (syntax_expr, ifile)
	call ifile_final (ifile)
	end subroutine syntax_expr_init

	module subroutine syntax_pexpr_init ()
	type(ifile_t) :: ifile
	call define_expr_syntax (ifile, particles=.true., analysis=.false.)
	call syntax_init (syntax_pexpr, ifile)
	call ifile_final (ifile)
	end subroutine syntax_pexpr_init

	@ %def syntax_expr_init syntax_pexpr_init
	<<Eval trees: public>>=
	public :: syntax_expr_final
	public :: syntax_pexpr_final
	<<Eval trees: sub interfaces>>=
	module subroutine syntax_expr_final ()
	end subroutine syntax_expr_final
	module subroutine syntax_pexpr_final ()
	end subroutine syntax_pexpr_final
	<<Eval trees: procedures>>=
	module subroutine syntax_expr_final ()
	call syntax_final (syntax_expr)
	end subroutine syntax_expr_final

	module subroutine syntax_pexpr_final ()
	call syntax_final (syntax_pexpr)
	end subroutine syntax_pexpr_final

	@ %def syntax_expr_final syntax_pexpr_final
	<<Eval trees: public>>=
	public :: syntax_pexpr_write
	<<Eval trees: sub interfaces>>=
	module subroutine syntax_pexpr_write (unit)
	integer, intent(in), optional :: unit
	end subroutine syntax_pexpr_write
	<<Eval trees: procedures>>=
	module subroutine syntax_pexpr_write (unit)
	integer, intent(in), optional :: unit
	call syntax_write (syntax_pexpr, unit)
	end subroutine syntax_pexpr_write

	@ %def syntax_pexpr_write
	<<Eval trees: public>>=
	public :: define_expr_syntax
	@ Numeric expressions.
	<<Eval trees: sub interfaces>>=
	module subroutine define_expr_syntax (ifile, particles, analysis)
	type(ifile_t), intent(inout) :: ifile
	logical, intent(in) :: particles, analysis
	end subroutine define_expr_syntax
	<<Eval trees: procedures>>=
	module subroutine define_expr_syntax (ifile, particles, analysis)
	type(ifile_t), intent(inout) :: ifile
	logical, intent(in) :: particles, analysis
	type(string_t) :: numeric_pexpr
	type(string_t) :: var_plist, var_alias
	if (particles) then
	numeric_pexpr = " \| numeric_pexpr"
	var_plist = " \| var_plist"
	var_alias = " \| var_alias"
	else
	numeric_pexpr = ""
	var_plist = ""
	var_alias = ""
	end if
	call ifile_append (ifile, "SEQ expr = subexpr addition*")
	call ifile_append (ifile, "ALT subexpr = addition \| term")
	call ifile_append (ifile, "SEQ addition = plus_or_minus term")
	call ifile_append (ifile, "SEQ term = factor multiplication*")
	call ifile_append (ifile, "SEQ multiplication = times_or_over factor")
	call ifile_append (ifile, "SEQ factor = value exponentiation?")
	call ifile_append (ifile, "SEQ exponentiation = to_the value")
	call ifile_append (ifile, "ALT plus_or_minus = '+' \| '-'")
	call ifile_append (ifile, "ALT times_or_over = '*' \| '/'")
	call ifile_append (ifile, "ALT to_the = '^' \| '**'")
	call ifile_append (ifile, "KEY '+'")
	call ifile_append (ifile, "KEY '-'")
	call ifile_append (ifile, "KEY '*'")
	call ifile_append (ifile, "KEY '/'")
	call ifile_append (ifile, "KEY '^'")
	call ifile_append (ifile, "KEY '**'")
	call ifile_append (ifile, "ALT value = signed_value \| unsigned_value")
	call ifile_append (ifile, "SEQ signed_value = '-' unsigned_value")
	call ifile_append (ifile, "ALT unsigned_value = " // &
	"numeric_value \| constant \| variable \| " // &
	"result \| " // &
	"grouped_expr \| block_expr \| conditional_expr \| " // &
	"unary_function \| binary_function" // &
	numeric_pexpr)
	call ifile_append (ifile, "ALT numeric_value = integer_value \| " &
	// "real_value \| complex_value")
	call ifile_append (ifile, "SEQ integer_value = integer_literal unit_expr?")
	call ifile_append (ifile, "SEQ real_value = real_literal unit_expr?")
	call ifile_append (ifile, "SEQ complex_value = complex_literal unit_expr?")
	call ifile_append (ifile, "INT integer_literal")
	call ifile_append (ifile, "REA real_literal")
	call ifile_append (ifile, "COM complex_literal")
	call ifile_append (ifile, "SEQ unit_expr = unit unit_power?")
	call ifile_append (ifile, "ALT unit = " // &
	"TeV \| GeV \| MeV \| keV \| eV \| meV \| " // &
	"nbarn \| pbarn \| fbarn \| abarn \| " // &
	"rad \| mrad \| degree \| '%'")
	call ifile_append (ifile, "KEY TeV")
	call ifile_append (ifile, "KEY GeV")
	call ifile_append (ifile, "KEY MeV")
	call ifile_append (ifile, "KEY keV")
	call ifile_append (ifile, "KEY eV")
	call ifile_append (ifile, "KEY meV")
	call ifile_append (ifile, "KEY nbarn")
	call ifile_append (ifile, "KEY pbarn")
	call ifile_append (ifile, "KEY fbarn")
	call ifile_append (ifile, "KEY abarn")
	call ifile_append (ifile, "KEY rad")
	call ifile_append (ifile, "KEY mrad")
	call ifile_append (ifile, "KEY degree")
	call ifile_append (ifile, "KEY '%'")
	call ifile_append (ifile, "SEQ unit_power = '^' frac_expr")
	call ifile_append (ifile, "ALT frac_expr = frac \| grouped_frac")
	call ifile_append (ifile, "GRO grouped_frac = ( frac_expr )")
	call ifile_append (ifile, "SEQ frac = signed_int div?")
	call ifile_append (ifile, "ALT signed_int = " &
	// "neg_int \| pos_int \| integer_literal")
	call ifile_append (ifile, "SEQ neg_int = '-' integer_literal")
	call ifile_append (ifile, "SEQ pos_int = '+' integer_literal")
	call ifile_append (ifile, "SEQ div = '/' integer_literal")
	call ifile_append (ifile, "ALT constant = pi \| I")
	call ifile_append (ifile, "KEY pi")
	call ifile_append (ifile, "KEY I")
	call ifile_append (ifile, "IDE variable")
	call ifile_append (ifile, "SEQ result = result_key result_arg")
	call ifile_append (ifile, "ALT result_key = " // &
	"num_id \| integral \| error")
	call ifile_append (ifile, "KEY num_id")
	call ifile_append (ifile, "KEY integral")
	call ifile_append (ifile, "KEY error")
	call ifile_append (ifile, "GRO result_arg = ( process_id )")
	call ifile_append (ifile, "IDE process_id")
	call ifile_append (ifile, "SEQ unary_function = fun_unary function_arg1")
	call ifile_append (ifile, "SEQ binary_function = fun_binary function_arg2")
	call ifile_append (ifile, "ALT fun_unary = " // &
	"complex \| real \| int \| nint \| floor \| ceiling \| abs \| conjg \| sgn \| " // &
	"sqrt \| exp \| log \| log10 \| " // &
	"sin \| cos \| tan \| asin \| acos \| atan \| " // &
	"sinh \| cosh \| tanh \| asinh \| acosh \| atanh")
	call ifile_append (ifile, "KEY complex")
	call ifile_append (ifile, "KEY real")
	call ifile_append (ifile, "KEY int")
	call ifile_append (ifile, "KEY nint")
	call ifile_append (ifile, "KEY floor")
	call ifile_append (ifile, "KEY ceiling")
	call ifile_append (ifile, "KEY abs")
	call ifile_append (ifile, "KEY conjg")
	call ifile_append (ifile, "KEY sgn")
	call ifile_append (ifile, "KEY sqrt")
	call ifile_append (ifile, "KEY exp")
	call ifile_append (ifile, "KEY log")
	call ifile_append (ifile, "KEY log10")
	call ifile_append (ifile, "KEY sin")
	call ifile_append (ifile, "KEY cos")
	call ifile_append (ifile, "KEY tan")
	call ifile_append (ifile, "KEY asin")
	call ifile_append (ifile, "KEY acos")
	call ifile_append (ifile, "KEY atan")
	call ifile_append (ifile, "KEY sinh")
	call ifile_append (ifile, "KEY cosh")
	call ifile_append (ifile, "KEY tanh")
	call ifile_append (ifile, "KEY asinh")
	call ifile_append (ifile, "KEY acosh")
	call ifile_append (ifile, "KEY atanh")
	call ifile_append (ifile, "ALT fun_binary = max \| min \| mod \| modulo")
	call ifile_append (ifile, "KEY max")
	call ifile_append (ifile, "KEY min")
	call ifile_append (ifile, "KEY mod")
	call ifile_append (ifile, "KEY modulo")
	call ifile_append (ifile, "ARG function_arg1 = ( expr )")
	call ifile_append (ifile, "ARG function_arg2 = ( expr, expr )")
	call ifile_append (ifile, "GRO grouped_expr = ( expr )")
	call ifile_append (ifile, "SEQ block_expr = let var_spec in expr")
	call ifile_append (ifile, "KEY let")
	call ifile_append (ifile, "ALT var_spec = " // &
	"var_num \| var_int \| var_real \| var_complex \| " // &
	"var_logical" // var_plist // var_alias // " \| var_string")
	call ifile_append (ifile, "SEQ var_num = var_name '=' expr")
	call ifile_append (ifile, "SEQ var_int = int var_name '=' expr")
	call ifile_append (ifile, "SEQ var_real = real var_name '=' expr")
	call ifile_append (ifile, "SEQ var_complex = complex var_name '=' complex_expr")
	call ifile_append (ifile, "ALT complex_expr = " // &
	"cexpr_real \| cexpr_complex")
	call ifile_append (ifile, "ARG cexpr_complex = ( expr, expr )")
	call ifile_append (ifile, "SEQ cexpr_real = expr")
	call ifile_append (ifile, "IDE var_name")
	call ifile_append (ifile, "KEY '='")
	call ifile_append (ifile, "KEY in")
	call ifile_append (ifile, "SEQ conditional_expr = " // &
	"if lexpr then expr maybe_elsif_expr maybe_else_expr endif")
	call ifile_append (ifile, "SEQ maybe_elsif_expr = elsif_expr*")
	call ifile_append (ifile, "SEQ maybe_else_expr = else_expr?")
	call ifile_append (ifile, "SEQ elsif_expr = elsif lexpr then expr")
	call ifile_append (ifile, "SEQ else_expr = else expr")
	call ifile_append (ifile, "KEY if")
	call ifile_append (ifile, "KEY then")
	call ifile_append (ifile, "KEY elsif")
	call ifile_append (ifile, "KEY else")
	call ifile_append (ifile, "KEY endif")
	call define_lexpr_syntax (ifile, particles, analysis)
	call define_sexpr_syntax (ifile)
	if (particles) then
	call define_pexpr_syntax (ifile)
	call define_cexpr_syntax (ifile)
	call define_var_plist_syntax (ifile)
	call define_var_alias_syntax (ifile)
	call define_numeric_pexpr_syntax (ifile)
	call define_logical_pexpr_syntax (ifile)
	end if

	end subroutine define_expr_syntax

	@ %def define_expr_syntax
	@ Logical expressions.
	<<Eval trees: procedures>>=
	subroutine define_lexpr_syntax (ifile, particles, analysis)
	type(ifile_t), intent(inout) :: ifile
	logical, intent(in) :: particles, analysis
	type(string_t) :: logical_pexpr, record_cmd
	if (particles) then
	logical_pexpr = " \| logical_pexpr"
	else
	logical_pexpr = ""
	end if
	if (analysis) then
	record_cmd = " \| record_cmd"
	else
	record_cmd = ""
	end if
	call ifile_append (ifile, "SEQ lexpr = lsinglet lsequel*")
	call ifile_append (ifile, "SEQ lsequel = ';' lsinglet")
	call ifile_append (ifile, "SEQ lsinglet = lterm alternative*")
	call ifile_append (ifile, "SEQ alternative = or lterm")
	call ifile_append (ifile, "SEQ lterm = lvalue coincidence*")
	call ifile_append (ifile, "SEQ coincidence = and lvalue")
	call ifile_append (ifile, "KEY ';'")
	call ifile_append (ifile, "KEY or")
	call ifile_append (ifile, "KEY and")
	call ifile_append (ifile, "ALT lvalue = " // &
	"true \| false \| lvariable \| negation \| " // &
	"grouped_lexpr \| block_lexpr \| conditional_lexpr \| " // &
	"compared_expr \| compared_sexpr" // &
	logical_pexpr // record_cmd)
	call ifile_append (ifile, "KEY true")
	call ifile_append (ifile, "KEY false")
	call ifile_append (ifile, "SEQ lvariable = '?' alt_lvariable")
	call ifile_append (ifile, "KEY '?'")
	call ifile_append (ifile, "ALT alt_lvariable = variable \| grouped_lexpr")
	call ifile_append (ifile, "SEQ negation = not lvalue")
	call ifile_append (ifile, "KEY not")
	call ifile_append (ifile, "GRO grouped_lexpr = ( lexpr )")
	call ifile_append (ifile, "SEQ block_lexpr = let var_spec in lexpr")
	call ifile_append (ifile, "ALT var_logical = " // &
	"var_logical_new \| var_logical_spec")
	call ifile_append (ifile, "SEQ var_logical_new = logical var_logical_spec")
	call ifile_append (ifile, "KEY logical")
	call ifile_append (ifile, "SEQ var_logical_spec = '?' var_name = lexpr")
	call ifile_append (ifile, "SEQ conditional_lexpr = " // &
	"if lexpr then lexpr maybe_elsif_lexpr maybe_else_lexpr endif")
	call ifile_append (ifile, "SEQ maybe_elsif_lexpr = elsif_lexpr*")
	call ifile_append (ifile, "SEQ maybe_else_lexpr = else_lexpr?")
	call ifile_append (ifile, "SEQ elsif_lexpr = elsif lexpr then lexpr")
	call ifile_append (ifile, "SEQ else_lexpr = else lexpr")
	call ifile_append (ifile, "SEQ compared_expr = expr comparison+")
	call ifile_append (ifile, "SEQ comparison = compare expr")
	call ifile_append (ifile, "ALT compare = " // &
	"'<' \| '>' \| '<=' \| '>=' \| '==' \| '<>'")
	call ifile_append (ifile, "KEY '<'")
	call ifile_append (ifile, "KEY '>'")
	call ifile_append (ifile, "KEY '<='")
	call ifile_append (ifile, "KEY '>='")
	call ifile_append (ifile, "KEY '=='")
	call ifile_append (ifile, "KEY '<>'")
	call ifile_append (ifile, "SEQ compared_sexpr = sexpr str_comparison+")
	call ifile_append (ifile, "SEQ str_comparison = str_compare sexpr")
	call ifile_append (ifile, "ALT str_compare = '==' \| '<>'")
	if (analysis) then
	call ifile_append (ifile, "SEQ record_cmd = " // &
	"record_key analysis_tag record_arg?")
	call ifile_append (ifile, "ALT record_key = " // &
	"record \| record_unweighted \| record_excess")
	call ifile_append (ifile, "KEY record")
	call ifile_append (ifile, "KEY record_unweighted")
	call ifile_append (ifile, "KEY record_excess")
	call ifile_append (ifile, "ALT analysis_tag = analysis_id \| sexpr")
	call ifile_append (ifile, "IDE analysis_id")
	call ifile_append (ifile, "ARG record_arg = ( expr+ )")
	end if
	end subroutine define_lexpr_syntax

	@ %def define_lexpr_syntax
	@ String expressions.
	<<Eval trees: procedures>>=
	subroutine define_sexpr_syntax (ifile)
	type(ifile_t), intent(inout) :: ifile
	call ifile_append (ifile, "SEQ sexpr = svalue str_concatenation*")
	call ifile_append (ifile, "SEQ str_concatenation = '&' svalue")
	call ifile_append (ifile, "KEY '&'")
	call ifile_append (ifile, "ALT svalue = " // &
	"grouped_sexpr \| block_sexpr \| conditional_sexpr \| " // &
	"svariable \| string_function \| string_literal")
	call ifile_append (ifile, "GRO grouped_sexpr = ( sexpr )")
	call ifile_append (ifile, "SEQ block_sexpr = let var_spec in sexpr")
	call ifile_append (ifile, "SEQ conditional_sexpr = " // &
	"if lexpr then sexpr maybe_elsif_sexpr maybe_else_sexpr endif")
	call ifile_append (ifile, "SEQ maybe_elsif_sexpr = elsif_sexpr*")
	call ifile_append (ifile, "SEQ maybe_else_sexpr = else_sexpr?")
	call ifile_append (ifile, "SEQ elsif_sexpr = elsif lexpr then sexpr")
	call ifile_append (ifile, "SEQ else_sexpr = else sexpr")
	call ifile_append (ifile, "SEQ svariable = '$' alt_svariable")
	call ifile_append (ifile, "KEY '$'")
	call ifile_append (ifile, "ALT alt_svariable = variable \| grouped_sexpr")
	call ifile_append (ifile, "ALT var_string = " // &
	"var_string_new \| var_string_spec")
	call ifile_append (ifile, "SEQ var_string_new = string var_string_spec")
	call ifile_append (ifile, "KEY string")
	call ifile_append (ifile, "SEQ var_string_spec = '$' var_name = sexpr") ! $
	call ifile_append (ifile, "ALT string_function = sprintf_fun")
	call ifile_append (ifile, "SEQ sprintf_fun = sprintf_clause sprintf_args?")
	call ifile_append (ifile, "SEQ sprintf_clause = sprintf sexpr")
	call ifile_append (ifile, "KEY sprintf")
	call ifile_append (ifile, "ARG sprintf_args = ( sprintf_arg* )")
	call ifile_append (ifile, "ALT sprintf_arg = " &
	// "lvariable \| svariable \| expr")
	call ifile_append (ifile, "QUO string_literal = '""'...'""'")
	end subroutine define_sexpr_syntax

	@ %def define_sexpr_syntax
	@ Eval trees that evaluate to subevents.
	<<Eval trees: procedures>>=
	subroutine define_pexpr_syntax (ifile)
	type(ifile_t), intent(inout) :: ifile
	call ifile_append (ifile, "SEQ pexpr = pterm pconcatenation*")
	call ifile_append (ifile, "SEQ pconcatenation = '&' pterm")
	! call ifile_append (ifile, "KEY '&'") !!! (Key exists already)
	call ifile_append (ifile, "SEQ pterm = pvalue pcombination*")
	call ifile_append (ifile, "SEQ pcombination = '+' pvalue")
	! call ifile_append (ifile, "KEY '+'") !!! (Key exists already)
	call ifile_append (ifile, "ALT pvalue = " // &
	"pexpr_src \| pvariable \| " // &
	"grouped_pexpr \| block_pexpr \| conditional_pexpr \| " // &
	"prt_function")
	call ifile_append (ifile, "SEQ pexpr_src = prefix_cexpr")
	call ifile_append (ifile, "ALT prefix_cexpr = " // &
	"beam_prt \| incoming_prt \| outgoing_prt \| unspecified_prt")
	call ifile_append (ifile, "SEQ beam_prt = beam cexpr")
	call ifile_append (ifile, "KEY beam")
	call ifile_append (ifile, "SEQ incoming_prt = incoming cexpr")
	call ifile_append (ifile, "KEY incoming")
	call ifile_append (ifile, "SEQ outgoing_prt = outgoing cexpr")
	call ifile_append (ifile, "KEY outgoing")
	call ifile_append (ifile, "SEQ unspecified_prt = cexpr")
	call ifile_append (ifile, "SEQ pvariable = '@' alt_pvariable")
	call ifile_append (ifile, "KEY '@'")
	call ifile_append (ifile, "ALT alt_pvariable = variable \| grouped_pexpr")
	call ifile_append (ifile, "GRO grouped_pexpr = '[' pexpr ']'")
	call ifile_append (ifile, "SEQ block_pexpr = let var_spec in pexpr")
	call ifile_append (ifile, "SEQ conditional_pexpr = " // &
	"if lexpr then pexpr maybe_elsif_pexpr maybe_else_pexpr endif")
	call ifile_append (ifile, "SEQ maybe_elsif_pexpr = elsif_pexpr*")
	call ifile_append (ifile, "SEQ maybe_else_pexpr = else_pexpr?")
	call ifile_append (ifile, "SEQ elsif_pexpr = elsif lexpr then pexpr")
	call ifile_append (ifile, "SEQ else_pexpr = else pexpr")
	call ifile_append (ifile, "ALT prt_function = " // &
	"join_fun \| combine_fun \| collect_fun \| cluster_fun \| " // &
	"photon_reco_fun \| " // &
	"select_fun \| extract_fun \| sort_fun \| " // &
	"select_b_jet_fun \| select_non_b_jet_fun \| " // &
	"select_c_jet_fun \| select_light_jet_fun")
	call ifile_append (ifile, "SEQ join_fun = join_clause pargs2")
	call ifile_append (ifile, "SEQ combine_fun = combine_clause pargs2")
	call ifile_append (ifile, "SEQ collect_fun = collect_clause pargs1")
	call ifile_append (ifile, "SEQ cluster_fun = cluster_clause pargs1")
	call ifile_append (ifile, "SEQ photon_reco_fun = photon_reco_clause pargs1")
	call ifile_append (ifile, "SEQ select_fun = select_clause pargs1")
	call ifile_append (ifile, "SEQ extract_fun = extract_clause pargs1")
	call ifile_append (ifile, "SEQ sort_fun = sort_clause pargs1")
	call ifile_append (ifile, "SEQ select_b_jet_fun = " // &
	"select_b_jet_clause pargs1")
	call ifile_append (ifile, "SEQ select_non_b_jet_fun = " // &
	"select_non_b_jet_clause pargs1")
	call ifile_append (ifile, "SEQ select_c_jet_fun = " // &
	"select_c_jet_clause pargs1")
	call ifile_append (ifile, "SEQ select_light_jet_fun = " // &
	"select_light_jet_clause pargs1")
	call ifile_append (ifile, "SEQ join_clause = join condition?")
	call ifile_append (ifile, "SEQ combine_clause = combine condition?")
	call ifile_append (ifile, "SEQ collect_clause = collect condition?")
	call ifile_append (ifile, "SEQ cluster_clause = cluster condition?")
	call ifile_append (ifile, "SEQ photon_reco_clause = photon_recombination condition?")
	call ifile_append (ifile, "SEQ select_clause = select condition?")
	call ifile_append (ifile, "SEQ extract_clause = extract position?")
	call ifile_append (ifile, "SEQ sort_clause = sort criterion?")
	call ifile_append (ifile, "SEQ select_b_jet_clause = " // &
	"select_b_jet condition?")
	call ifile_append (ifile, "SEQ select_non_b_jet_clause = " // &
	"select_non_b_jet condition?")
	call ifile_append (ifile, "SEQ select_c_jet_clause = " // &
	"select_c_jet condition?")
	call ifile_append (ifile, "SEQ select_light_jet_clause = " // &
	"select_light_jet condition?")
	call ifile_append (ifile, "KEY join")
	call ifile_append (ifile, "KEY combine")
	call ifile_append (ifile, "KEY collect")
	call ifile_append (ifile, "KEY cluster")
	call ifile_append (ifile, "KEY photon_recombination")
	call ifile_append (ifile, "KEY select")
	call ifile_append (ifile, "SEQ condition = if lexpr")
	call ifile_append (ifile, "KEY extract")
	call ifile_append (ifile, "SEQ position = index expr")
	call ifile_append (ifile, "KEY sort")
	call ifile_append (ifile, "KEY select_b_jet")
	call ifile_append (ifile, "KEY select_non_b_jet")
	call ifile_append (ifile, "KEY select_c_jet")
	call ifile_append (ifile, "KEY select_light_jet")
	call ifile_append (ifile, "SEQ criterion = by expr")
	call ifile_append (ifile, "KEY index")
	call ifile_append (ifile, "KEY by")
	call ifile_append (ifile, "ARG pargs2 = '[' pexpr, pexpr ']'")
	call ifile_append (ifile, "ARG pargs1 = '[' pexpr, pexpr? ']'")
	end subroutine define_pexpr_syntax

	@ %def define_pexpr_syntax
	@ Eval trees that evaluate to PDG-code arrays.
	<<Eval trees: procedures>>=
	subroutine define_cexpr_syntax (ifile)
	type(ifile_t), intent(inout) :: ifile
	call ifile_append (ifile, "SEQ cexpr = avalue concatenation*")
	call ifile_append (ifile, "SEQ concatenation = ':' avalue")
	call ifile_append (ifile, "KEY ':'")
	call ifile_append (ifile, "ALT avalue = " // &
	"grouped_cexpr \| block_cexpr \| conditional_cexpr \| " // &
	"variable \| pdg_code \| prt_name")
	call ifile_append (ifile, "GRO grouped_cexpr = ( cexpr )")
	call ifile_append (ifile, "SEQ block_cexpr = let var_spec in cexpr")
	call ifile_append (ifile, "SEQ conditional_cexpr = " // &
	"if lexpr then cexpr maybe_elsif_cexpr maybe_else_cexpr endif")
	call ifile_append (ifile, "SEQ maybe_elsif_cexpr = elsif_cexpr*")
	call ifile_append (ifile, "SEQ maybe_else_cexpr = else_cexpr?")
	call ifile_append (ifile, "SEQ elsif_cexpr = elsif lexpr then cexpr")
	call ifile_append (ifile, "SEQ else_cexpr = else cexpr")
	call ifile_append (ifile, "SEQ pdg_code = pdg pdg_arg")
	call ifile_append (ifile, "KEY pdg")
	call ifile_append (ifile, "ARG pdg_arg = ( expr )")
	call ifile_append (ifile, "QUO prt_name = '""'...'""'")
	end subroutine define_cexpr_syntax

	@ %def define_cexpr_syntax
	@ Extra variable types.
	<<Eval trees: procedures>>=
	subroutine define_var_plist_syntax (ifile)
	type(ifile_t), intent(inout) :: ifile
	call ifile_append (ifile, "ALT var_plist = var_plist_new \| var_plist_spec")
	call ifile_append (ifile, "SEQ var_plist_new = subevt var_plist_spec")
	call ifile_append (ifile, "KEY subevt")
	call ifile_append (ifile, "SEQ var_plist_spec = '@' var_name '=' pexpr")
	end subroutine define_var_plist_syntax

	subroutine define_var_alias_syntax (ifile)
	type(ifile_t), intent(inout) :: ifile
	call ifile_append (ifile, "SEQ var_alias = alias var_name '=' cexpr")
	call ifile_append (ifile, "KEY alias")
	end subroutine define_var_alias_syntax

	@ %def define_var_plist_syntax define_var_alias_syntax
	@ Particle-list expressions that evaluate to numeric values
	<<Eval trees: procedures>>=
	subroutine define_numeric_pexpr_syntax (ifile)
	type(ifile_t), intent(inout) :: ifile
	call ifile_append (ifile, "ALT numeric_pexpr = " &
	// "eval_fun \| count_fun \| sum_fun \| " &
	// "prod_fun")
	call ifile_append (ifile, "SEQ eval_fun = eval expr pargs1")
	call ifile_append (ifile, "SEQ count_fun = count_clause pargs1")
	call ifile_append (ifile, "SEQ count_clause = count condition?")
	call ifile_append (ifile, "SEQ sum_fun = sum expr pargs1")
	call ifile_append (ifile, "SEQ prod_fun = prod expr pargs1")
	call ifile_append (ifile, "KEY eval")
	call ifile_append (ifile, "KEY count")
	call ifile_append (ifile, "KEY sum")
	call ifile_append (ifile, "KEY prod")
	end subroutine define_numeric_pexpr_syntax

	@ %def define_numeric_pexpr_syntax
	@ Particle-list functions that evaluate to logical values.
	<<Eval trees: procedures>>=
	subroutine define_logical_pexpr_syntax (ifile)
	type(ifile_t), intent(inout) :: ifile
	call ifile_append (ifile, "ALT logical_pexpr = " // &
	"all_fun \| any_fun \| no_fun \| " // &
	"photon_isolation_fun")
	call ifile_append (ifile, "SEQ all_fun = all lexpr pargs1")
	call ifile_append (ifile, "SEQ any_fun = any lexpr pargs1")
	call ifile_append (ifile, "SEQ no_fun = no lexpr pargs1")
	call ifile_append (ifile, "SEQ photon_isolation_fun = " // &
	"photon_isolation_clause pargs2")
	call ifile_append (ifile, "SEQ photon_isolation_clause = " // &
	"photon_isolation condition?")
	call ifile_append (ifile, "KEY all")
	call ifile_append (ifile, "KEY any")
	call ifile_append (ifile, "KEY no")
	call ifile_append (ifile, "KEY photon_isolation")
	end subroutine define_logical_pexpr_syntax

	@ %def define_logical_pexpr_syntax
	@ All characters that can occur in expressions (apart from alphanumeric).
	<<Eval trees: procedures>>=
	subroutine lexer_init_eval_tree (lexer, particles)
	type(lexer_t), intent(out) :: lexer
	logical, intent(in) :: particles
	type(keyword_list_t), pointer :: keyword_list
	if (particles) then
	keyword_list => syntax_get_keyword_list_ptr (syntax_pexpr)
	else
	keyword_list => syntax_get_keyword_list_ptr (syntax_expr)
	end if
	call lexer_init (lexer, &
	comment_chars = "#!", &
	quote_chars = '"', &
	quote_match = '"', &
	single_chars = "()[],;:&%?$@", &
	special_class = [ "+-*/^", "<>=~ " ] , &
	keyword_list = keyword_list)
	end subroutine lexer_init_eval_tree

	@ %def lexer_init_eval_tree
	@
	\subsection{Set up appropriate parse trees}
	Parse an input stream as a specific flavor of expression. The
	appropriate expression syntax has to be available.
	<<Eval trees: public>>=
	public :: parse_tree_init_expr
	public :: parse_tree_init_lexpr
	public :: parse_tree_init_pexpr
	public :: parse_tree_init_cexpr
	public :: parse_tree_init_sexpr
	<<Eval trees: sub interfaces>>=
	module subroutine parse_tree_init_expr (parse_tree, stream, particles)
	type(parse_tree_t), intent(out) :: parse_tree
	type(stream_t), intent(inout), target :: stream
	logical, intent(in) :: particles
	end subroutine parse_tree_init_expr
	module subroutine parse_tree_init_lexpr (parse_tree, stream, particles)
	type(parse_tree_t), intent(out) :: parse_tree
	type(stream_t), intent(inout), target :: stream
	logical, intent(in) :: particles
	end subroutine parse_tree_init_lexpr
	module subroutine parse_tree_init_pexpr (parse_tree, stream)
	type(parse_tree_t), intent(out) :: parse_tree
	type(stream_t), intent(inout), target :: stream
	end subroutine parse_tree_init_pexpr
	module subroutine parse_tree_init_cexpr (parse_tree, stream)
	type(parse_tree_t), intent(out) :: parse_tree
	type(stream_t), intent(inout), target :: stream
	end subroutine parse_tree_init_cexpr
	module subroutine parse_tree_init_sexpr (parse_tree, stream, particles)
	type(parse_tree_t), intent(out) :: parse_tree
	type(stream_t), intent(inout), target :: stream
	logical, intent(in) :: particles
	end subroutine parse_tree_init_sexpr
	<<Eval trees: procedures>>=
	module subroutine parse_tree_init_expr (parse_tree, stream, particles)
	type(parse_tree_t), intent(out) :: parse_tree
	type(stream_t), intent(inout), target :: stream
	logical, intent(in) :: particles
	type(lexer_t) :: lexer
	call lexer_init_eval_tree (lexer, particles)
	call lexer_assign_stream (lexer, stream)
	if (particles) then
	call parse_tree_init &
	(parse_tree, syntax_pexpr, lexer, var_str ("expr"))
	else
	call parse_tree_init &
	(parse_tree, syntax_expr, lexer, var_str ("expr"))
	end if
	call lexer_final (lexer)
	end subroutine parse_tree_init_expr

	module subroutine parse_tree_init_lexpr (parse_tree, stream, particles)
	type(parse_tree_t), intent(out) :: parse_tree
	type(stream_t), intent(inout), target :: stream
	logical, intent(in) :: particles
	type(lexer_t) :: lexer
	call lexer_init_eval_tree (lexer, particles)
	call lexer_assign_stream (lexer, stream)
	if (particles) then
	call parse_tree_init &
	(parse_tree, syntax_pexpr, lexer, var_str ("lexpr"))
	else
	call parse_tree_init &
	(parse_tree, syntax_expr, lexer, var_str ("lexpr"))
	end if
	call lexer_final (lexer)
	end subroutine parse_tree_init_lexpr

	module subroutine parse_tree_init_pexpr (parse_tree, stream)
	type(parse_tree_t), intent(out) :: parse_tree
	type(stream_t), intent(inout), target :: stream
	type(lexer_t) :: lexer
	call lexer_init_eval_tree (lexer, .true.)
	call lexer_assign_stream (lexer, stream)
	call parse_tree_init &
	(parse_tree, syntax_pexpr, lexer, var_str ("pexpr"))
	call lexer_final (lexer)
	end subroutine parse_tree_init_pexpr

	module subroutine parse_tree_init_cexpr (parse_tree, stream)
	type(parse_tree_t), intent(out) :: parse_tree
	type(stream_t), intent(inout), target :: stream
	type(lexer_t) :: lexer
	call lexer_init_eval_tree (lexer, .true.)
	call lexer_assign_stream (lexer, stream)
	call parse_tree_init &
	(parse_tree, syntax_pexpr, lexer, var_str ("cexpr"))
	call lexer_final (lexer)
	end subroutine parse_tree_init_cexpr

	module subroutine parse_tree_init_sexpr (parse_tree, stream, particles)
	type(parse_tree_t), intent(out) :: parse_tree
	type(stream_t), intent(inout), target :: stream
	logical, intent(in) :: particles
	type(lexer_t) :: lexer
	call lexer_init_eval_tree (lexer, particles)
	call lexer_assign_stream (lexer, stream)
	if (particles) then
	call parse_tree_init &
	(parse_tree, syntax_pexpr, lexer, var_str ("sexpr"))
	else
	call parse_tree_init &
	(parse_tree, syntax_expr, lexer, var_str ("sexpr"))
	end if
	call lexer_final (lexer)
	end subroutine parse_tree_init_sexpr

	@ %def parse_tree_init_expr
	@ %def parse_tree_init_lexpr
	@ %def parse_tree_init_pexpr
	@ %def parse_tree_init_cexpr
	@ %def parse_tree_init_sexpr
	@
	\subsection{The evaluation tree}
	The evaluation tree contains the initial variable list and the root node.
	<<Eval trees: public>>=
	public :: eval_tree_t
	<<Eval trees: types>>=
	type, extends (expr_t) :: eval_tree_t
	private
	type(parse_node_t), pointer :: pn => null ()
	type(var_list_t) :: var_list
	type(eval_node_t), pointer :: root => null ()
	contains
	<<Eval trees: eval tree: TBP>>
	end type eval_tree_t

	@ %def eval_tree_t
	@ Init from stream, using a temporary parse tree.
	<<Eval trees: eval tree: TBP>>=
	procedure :: init_stream => eval_tree_init_stream
	<<Eval trees: sub interfaces>>=
	module subroutine eval_tree_init_stream &
	(eval_tree, stream, var_list, subevt, result_type)
	class(eval_tree_t), intent(out), target :: eval_tree
	type(stream_t), intent(inout), target :: stream
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), target, optional :: subevt
	integer, intent(in), optional :: result_type
	end subroutine eval_tree_init_stream
	<<Eval trees: procedures>>=
	module subroutine eval_tree_init_stream &
	(eval_tree, stream, var_list, subevt, result_type)
	class(eval_tree_t), intent(out), target :: eval_tree
	type(stream_t), intent(inout), target :: stream
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), target, optional :: subevt
	integer, intent(in), optional :: result_type
	type(parse_tree_t) :: parse_tree
	type(parse_node_t), pointer :: nd_root
	integer :: type
	type = V_REAL; if (present (result_type)) type = result_type
	select case (type)
	case (V_INT, V_REAL, V_CMPLX)
	call parse_tree_init_expr (parse_tree, stream, present (subevt))
	case (V_LOG)
	call parse_tree_init_lexpr (parse_tree, stream, present (subevt))
	case (V_SEV)
	call parse_tree_init_pexpr (parse_tree, stream)
	case (V_PDG)
	call parse_tree_init_cexpr (parse_tree, stream)
	case (V_STR)
	call parse_tree_init_sexpr (parse_tree, stream, present (subevt))
	end select
	nd_root => parse_tree%get_root_ptr ()
	if (associated (nd_root)) then
	select case (type)
	case (V_INT, V_REAL, V_CMPLX)
	call eval_tree_init_expr (eval_tree, nd_root, var_list, subevt)
	case (V_LOG)
	call eval_tree_init_lexpr (eval_tree, nd_root, var_list, subevt)
	case (V_SEV)
	call eval_tree_init_pexpr (eval_tree, nd_root, var_list, subevt)
	case (V_PDG)
	call eval_tree_init_cexpr (eval_tree, nd_root, var_list, subevt)
	case (V_STR)
	call eval_tree_init_sexpr (eval_tree, nd_root, var_list, subevt)
	end select
	end if
	call parse_tree_final (parse_tree)
	end subroutine eval_tree_init_stream

	@ %def eval_tree_init_stream
	@ API (to be superseded by the methods below): Init from a given parse-tree
	node. If we evaluate an expression that contains particle-list references,
	the original subevent has to be supplied. The initial variable list is
	optional.
	<<Eval trees: eval tree: TBP>>=
	procedure :: init_expr => eval_tree_init_expr
	procedure :: init_lexpr => eval_tree_init_lexpr
	procedure :: init_pexpr => eval_tree_init_pexpr
	procedure :: init_cexpr => eval_tree_init_cexpr
	procedure :: init_sexpr => eval_tree_init_sexpr
	<<Eval trees: sub interfaces>>=
	module subroutine eval_tree_init_expr &
	(expr, parse_node, var_list, subevt)
	class(eval_tree_t), intent(out), target :: expr
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	end subroutine eval_tree_init_expr
	module subroutine eval_tree_init_lexpr &
	(expr, parse_node, var_list, subevt)
	class(eval_tree_t), intent(out), target :: expr
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	end subroutine eval_tree_init_lexpr
	module subroutine eval_tree_init_pexpr &
	(expr, parse_node, var_list, subevt)
	class(eval_tree_t), intent(out), target :: expr
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	end subroutine eval_tree_init_pexpr
	module subroutine eval_tree_init_cexpr &
	(expr, parse_node, var_list, subevt)
	class(eval_tree_t), intent(out), target :: expr
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	end subroutine eval_tree_init_cexpr
	module subroutine eval_tree_init_sexpr &
	(expr, parse_node, var_list, subevt)
	class(eval_tree_t), intent(out), target :: expr
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	end subroutine eval_tree_init_sexpr
	<<Eval trees: procedures>>=
	module subroutine eval_tree_init_expr &
	(expr, parse_node, var_list, subevt)
	class(eval_tree_t), intent(out), target :: expr
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	call eval_tree_link_var_list (expr, var_list)
	if (present (subevt)) call eval_tree_set_subevt (expr, subevt)
	call eval_node_compile_expr &
	(expr%root, parse_node, expr%var_list)
	end subroutine eval_tree_init_expr

	module subroutine eval_tree_init_lexpr &
	(expr, parse_node, var_list, subevt)
	class(eval_tree_t), intent(out), target :: expr
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	call eval_tree_link_var_list (expr, var_list)
	if (present (subevt)) call eval_tree_set_subevt (expr, subevt)
	call eval_node_compile_lexpr &
	(expr%root, parse_node, expr%var_list)
	end subroutine eval_tree_init_lexpr

	module subroutine eval_tree_init_pexpr &
	(expr, parse_node, var_list, subevt)
	class(eval_tree_t), intent(out), target :: expr
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	call eval_tree_link_var_list (expr, var_list)
	if (present (subevt)) call eval_tree_set_subevt (expr, subevt)
	call eval_node_compile_pexpr &
	(expr%root, parse_node, expr%var_list)
	end subroutine eval_tree_init_pexpr

	module subroutine eval_tree_init_cexpr &
	(expr, parse_node, var_list, subevt)
	class(eval_tree_t), intent(out), target :: expr
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	call eval_tree_link_var_list (expr, var_list)
	if (present (subevt)) call eval_tree_set_subevt (expr, subevt)
	call eval_node_compile_cexpr &
	(expr%root, parse_node, expr%var_list)
	end subroutine eval_tree_init_cexpr

	module subroutine eval_tree_init_sexpr &
	(expr, parse_node, var_list, subevt)
	class(eval_tree_t), intent(out), target :: expr
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	call eval_tree_link_var_list (expr, var_list)
	if (present (subevt)) call eval_tree_set_subevt (expr, subevt)
	call eval_node_compile_sexpr &
	(expr%root, parse_node, expr%var_list)
	end subroutine eval_tree_init_sexpr

	@ %def eval_tree_init_expr
	@ %def eval_tree_init_lexpr
	@ %def eval_tree_init_pexpr
	@ %def eval_tree_init_cexpr
	@ %def eval_tree_init_sexpr
	@ Alternative: set up the expression using the parse node that has already
	been stored. We assume that the [[subevt]] or any other variable that
	may be referred to has already been added to the local variable list.
	<<Eval trees: eval tree: TBP>>=
	procedure :: setup_expr => eval_tree_setup_expr
	procedure :: setup_lexpr => eval_tree_setup_lexpr
	procedure :: setup_pexpr => eval_tree_setup_pexpr
	procedure :: setup_cexpr => eval_tree_setup_cexpr
	procedure :: setup_sexpr => eval_tree_setup_sexpr
	<<Eval trees: sub interfaces>>=
	module subroutine eval_tree_setup_expr (expr, vars)
	class(eval_tree_t), intent(inout), target :: expr
	class(vars_t), intent(in), target :: vars
	end subroutine eval_tree_setup_expr
	module subroutine eval_tree_setup_lexpr (expr, vars)
	class(eval_tree_t), intent(inout), target :: expr
	class(vars_t), intent(in), target :: vars
	end subroutine eval_tree_setup_lexpr
	module subroutine eval_tree_setup_pexpr (expr, vars)
	class(eval_tree_t), intent(inout), target :: expr
	class(vars_t), intent(in), target :: vars
	end subroutine eval_tree_setup_pexpr
	module subroutine eval_tree_setup_cexpr (expr, vars)
	class(eval_tree_t), intent(inout), target :: expr
	class(vars_t), intent(in), target :: vars
	end subroutine eval_tree_setup_cexpr
	module subroutine eval_tree_setup_sexpr (expr, vars)
	class(eval_tree_t), intent(inout), target :: expr
	class(vars_t), intent(in), target :: vars
	end subroutine eval_tree_setup_sexpr
	<<Eval trees: procedures>>=
	module subroutine eval_tree_setup_expr (expr, vars)
	class(eval_tree_t), intent(inout), target :: expr
	class(vars_t), intent(in), target :: vars
	call eval_tree_link_var_list (expr, vars)
	call eval_node_compile_expr (expr%root, expr%pn, expr%var_list)
	end subroutine eval_tree_setup_expr

	module subroutine eval_tree_setup_lexpr (expr, vars)
	class(eval_tree_t), intent(inout), target :: expr
	class(vars_t), intent(in), target :: vars
	call eval_tree_link_var_list (expr, vars)
	call eval_node_compile_lexpr (expr%root, expr%pn, expr%var_list)
	end subroutine eval_tree_setup_lexpr

	module subroutine eval_tree_setup_pexpr (expr, vars)
	class(eval_tree_t), intent(inout), target :: expr
	class(vars_t), intent(in), target :: vars
	call eval_tree_link_var_list (expr, vars)
	call eval_node_compile_pexpr (expr%root, expr%pn, expr%var_list)
	end subroutine eval_tree_setup_pexpr

	module subroutine eval_tree_setup_cexpr (expr, vars)
	class(eval_tree_t), intent(inout), target :: expr
	class(vars_t), intent(in), target :: vars
	call eval_tree_link_var_list (expr, vars)
	call eval_node_compile_cexpr (expr%root, expr%pn, expr%var_list)
	end subroutine eval_tree_setup_cexpr

	module subroutine eval_tree_setup_sexpr (expr, vars)
	class(eval_tree_t), intent(inout), target :: expr
	class(vars_t), intent(in), target :: vars
	call eval_tree_link_var_list (expr, vars)
	call eval_node_compile_sexpr (expr%root, expr%pn, expr%var_list)
	end subroutine eval_tree_setup_sexpr

	@ %def eval_tree_setup_expr
	@ %def eval_tree_setup_lexpr
	@ %def eval_tree_setup_pexpr
	@ %def eval_tree_setup_cexpr
	@ %def eval_tree_setup_sexpr
	@ This extra API function handles numerical constant expressions only.
	The only nontrivial part is the optional unit.
	<<Eval trees: eval tree: TBP>>=
	procedure :: init_numeric_value => eval_tree_init_numeric_value
	<<Eval trees: sub interfaces>>=
	module subroutine eval_tree_init_numeric_value (eval_tree, parse_node)
	class(eval_tree_t), intent(out), target :: eval_tree
	type(parse_node_t), intent(in), target :: parse_node
	end subroutine eval_tree_init_numeric_value
	<<Eval trees: procedures>>=
	module subroutine eval_tree_init_numeric_value (eval_tree, parse_node)
	class(eval_tree_t), intent(out), target :: eval_tree
	type(parse_node_t), intent(in), target :: parse_node
	call eval_node_compile_numeric_value (eval_tree%root, parse_node)
	end subroutine eval_tree_init_numeric_value

	@ %def eval_tree_init_numeric_value
	@ Initialize the variable list, linking it to a context variable list.
	<<Eval trees: procedures>>=
	subroutine eval_tree_link_var_list (eval_tree, vars)
	type(eval_tree_t), intent(inout), target :: eval_tree
	class(vars_t), intent(in), target :: vars
	call eval_tree%var_list%link (vars)
	end subroutine eval_tree_link_var_list

	@ %def eval_tree_link_var_list
	@ Include a subevent object in the initialization. We add a pointer
	to this as variable [[@evt]] in the local variable list.
	<<Eval trees: procedures>>=
	subroutine eval_tree_set_subevt (eval_tree, subevt)
	type(eval_tree_t), intent(inout), target :: eval_tree
	type(subevt_t), intent(in), target :: subevt
	logical, save, target :: known = .true.
	call eval_tree%var_list%append_subevt_ptr &
	(var_str ("@evt"), subevt, known, intrinsic=.true.)
	end subroutine eval_tree_set_subevt

	@ %def eval_tree_set_subevt
	@ Finalizer.
	<<Eval trees: eval tree: TBP>>=
	procedure :: final => eval_tree_final
	<<Eval trees: sub interfaces>>=
	module subroutine eval_tree_final (expr)
	class(eval_tree_t), intent(inout) :: expr
	end subroutine eval_tree_final
	<<Eval trees: procedures>>=
	module subroutine eval_tree_final (expr)
	class(eval_tree_t), intent(inout) :: expr
	call expr%var_list%final ()
	if (associated (expr%root)) then
	call eval_node_final_rec (expr%root)
	deallocate (expr%root)
	end if
	end subroutine eval_tree_final

	@ %def eval_tree_final
	@
	<<Eval trees: eval tree: TBP>>=
	procedure :: evaluate => eval_tree_evaluate
	<<Eval trees: sub interfaces>>=
	module subroutine eval_tree_evaluate (expr)
	class(eval_tree_t), intent(inout) :: expr
	end subroutine eval_tree_evaluate
	<<Eval trees: procedures>>=
	module subroutine eval_tree_evaluate (expr)
	class(eval_tree_t), intent(inout) :: expr
	if (associated (expr%root)) then
	call eval_node_evaluate (expr%root)
	end if
	end subroutine eval_tree_evaluate

	@ %def eval_tree_evaluate
	@ Check if the eval tree is allocated.
	<<Eval trees: procedures>>=
	function eval_tree_is_defined (eval_tree) result (flag)
	logical :: flag
	type(eval_tree_t), intent(in) :: eval_tree
	flag = associated (eval_tree%root)
	end function eval_tree_is_defined

	@ %def eval_tree_is_defined
	@ Check if the eval tree result is constant.
	<<Eval trees: procedures>>=
	function eval_tree_is_constant (eval_tree) result (flag)
	logical :: flag
	type(eval_tree_t), intent(in) :: eval_tree
	if (associated (eval_tree%root)) then
	flag = eval_tree%root%type == EN_CONSTANT
	else
	flag = .false.
	end if
	end function eval_tree_is_constant

	@ %def eval_tree_is_constant
	@ Insert a conversion node at the root, if necessary (only for
	real/int conversion)
	<<Eval trees: procedures>>=
	subroutine eval_tree_convert_result (eval_tree, result_type)
	type(eval_tree_t), intent(inout) :: eval_tree
	integer, intent(in) :: result_type
	if (associated (eval_tree%root)) then
	call insert_conversion_node (eval_tree%root, result_type)
	end if
	end subroutine eval_tree_convert_result

	@ %def eval_tree_convert_result
	@ Return the value of the top node, after evaluation. If the tree is
	empty, return the type of [[V_NONE]]. When extracting the value, no
	check for existence is done. For numeric values, the functions are
	safe against real/integer mismatch.
	<<Eval trees: eval tree: TBP>>=
	procedure :: is_known => eval_tree_result_is_known
	procedure :: get_log => eval_tree_get_log
	procedure :: get_int => eval_tree_get_int
	procedure :: get_real => eval_tree_get_real
	procedure :: get_cmplx => eval_tree_get_cmplx
	procedure :: get_pdg_array => eval_tree_get_pdg_array
	procedure :: get_subevt => eval_tree_get_subevt
	procedure :: get_string => eval_tree_get_string
	<<Eval trees: sub interfaces>>=
	module function eval_tree_get_result_type (expr) result (type)
	integer :: type
	class(eval_tree_t), intent(in) :: expr
	end function eval_tree_get_result_type
	module function eval_tree_result_is_known (expr) result (flag)
	logical :: flag
	class(eval_tree_t), intent(in) :: expr
	end function eval_tree_result_is_known
	module function eval_tree_result_is_known_ptr (expr) result (ptr)
	logical, pointer :: ptr
	class(eval_tree_t), intent(in) :: expr
	end function eval_tree_result_is_known_ptr
	module function eval_tree_get_log (expr) result (lval)
	logical :: lval
	class(eval_tree_t), intent(in) :: expr
	end function eval_tree_get_log
	module function eval_tree_get_int (expr) result (ival)
	integer :: ival
	class(eval_tree_t), intent(in) :: expr
	end function eval_tree_get_int
	module function eval_tree_get_real (expr) result (rval)
	real(default) :: rval
	class(eval_tree_t), intent(in) :: expr
	end function eval_tree_get_real
	module function eval_tree_get_cmplx (expr) result (cval)
	complex(default) :: cval
	class(eval_tree_t), intent(in) :: expr
	end function eval_tree_get_cmplx
	module function eval_tree_get_pdg_array (expr) result (aval)
	type(pdg_array_t) :: aval
	class(eval_tree_t), intent(in) :: expr
	end function eval_tree_get_pdg_array
	module function eval_tree_get_subevt (expr) result (pval)
	type(subevt_t) :: pval
	class(eval_tree_t), intent(in) :: expr
	end function eval_tree_get_subevt
	module function eval_tree_get_string (expr) result (sval)
	type(string_t) :: sval
	class(eval_tree_t), intent(in) :: expr
	end function eval_tree_get_string
	<<Eval trees: procedures>>=
	module function eval_tree_get_result_type (expr) result (type)
	integer :: type
	class(eval_tree_t), intent(in) :: expr
	if (associated (expr%root)) then
	type = expr%root%result_type
	else
	type = V_NONE
	end if
	end function eval_tree_get_result_type

	module function eval_tree_result_is_known (expr) result (flag)
	logical :: flag
	class(eval_tree_t), intent(in) :: expr
	if (associated (expr%root)) then
	select case (expr%root%result_type)
	case (V_LOG, V_INT, V_REAL)
	flag = expr%root%value_is_known
	case default
	flag = .true.
	end select
	else
	flag = .false.
	end if
	end function eval_tree_result_is_known

	module function eval_tree_result_is_known_ptr (expr) result (ptr)
	logical, pointer :: ptr
	class(eval_tree_t), intent(in) :: expr
	logical, target, save :: known = .true.
	if (associated (expr%root)) then
	select case (expr%root%result_type)
	case (V_LOG, V_INT, V_REAL)
	ptr => expr%root%value_is_known
	case default
	ptr => known
	end select
	else
	ptr => null ()
	end if
	end function eval_tree_result_is_known_ptr

	module function eval_tree_get_log (expr) result (lval)
	logical :: lval
	class(eval_tree_t), intent(in) :: expr
	if (associated (expr%root)) lval = expr%root%lval
	end function eval_tree_get_log

	module function eval_tree_get_int (expr) result (ival)
	integer :: ival
	class(eval_tree_t), intent(in) :: expr
	if (associated (expr%root)) then
	select case (expr%root%result_type)
	case (V_INT); ival = expr%root%ival
	case (V_REAL); ival = expr%root%rval
	case (V_CMPLX); ival = expr%root%cval
	end select
	end if
	end function eval_tree_get_int

	module function eval_tree_get_real (expr) result (rval)
	real(default) :: rval
	class(eval_tree_t), intent(in) :: expr
	if (associated (expr%root)) then
	select case (expr%root%result_type)
	case (V_REAL); rval = expr%root%rval
	case (V_INT); rval = expr%root%ival
	case (V_CMPLX); rval = expr%root%cval
	end select
	end if
	end function eval_tree_get_real

	module function eval_tree_get_cmplx (expr) result (cval)
	complex(default) :: cval
	class(eval_tree_t), intent(in) :: expr
	if (associated (expr%root)) then
	select case (expr%root%result_type)
	case (V_CMPLX); cval = expr%root%cval
	case (V_REAL); cval = expr%root%rval
	case (V_INT); cval = expr%root%ival
	end select
	end if
	end function eval_tree_get_cmplx

	module function eval_tree_get_pdg_array (expr) result (aval)
	type(pdg_array_t) :: aval
	class(eval_tree_t), intent(in) :: expr
	if (associated (expr%root)) then
	aval = expr%root%aval
	end if
	end function eval_tree_get_pdg_array

	module function eval_tree_get_subevt (expr) result (pval)
	type(subevt_t) :: pval
	class(eval_tree_t), intent(in) :: expr
	if (associated (expr%root)) then
	pval = expr%root%pval
	end if
	end function eval_tree_get_subevt

	module function eval_tree_get_string (expr) result (sval)
	type(string_t) :: sval
	class(eval_tree_t), intent(in) :: expr
	if (associated (expr%root)) then
	sval = expr%root%sval
	end if
	end function eval_tree_get_string

	@ %def eval_tree_get_result_type
	@ %def eval_tree_result_is_known
	@ %def eval_tree_get_log eval_tree_get_int eval_tree_get_real
	@ %def eval_tree_get_cmplx
	@ %def eval_tree_get_pdg_expr
	@ %def eval_tree_get_pdg_array
	@ %def eval_tree_get_subevt
	@ %def eval_tree_get_string
	@ Return a pointer to the value of the top node.
	<<Eval trees: procedures>>=
	function eval_tree_get_log_ptr (eval_tree) result (lval)
	logical, pointer :: lval
	type(eval_tree_t), intent(in) :: eval_tree
	if (associated (eval_tree%root)) then
	lval => eval_tree%root%lval
	else
	lval => null ()
	end if
	end function eval_tree_get_log_ptr

	function eval_tree_get_int_ptr (eval_tree) result (ival)
	integer, pointer :: ival
	type(eval_tree_t), intent(in) :: eval_tree
	if (associated (eval_tree%root)) then
	ival => eval_tree%root%ival
	else
	ival => null ()
	end if
	end function eval_tree_get_int_ptr

	function eval_tree_get_real_ptr (eval_tree) result (rval)
	real(default), pointer :: rval
	type(eval_tree_t), intent(in) :: eval_tree
	if (associated (eval_tree%root)) then
	rval => eval_tree%root%rval
	else
	rval => null ()
	end if
	end function eval_tree_get_real_ptr

	function eval_tree_get_cmplx_ptr (eval_tree) result (cval)
	complex(default), pointer :: cval
	type(eval_tree_t), intent(in) :: eval_tree
	if (associated (eval_tree%root)) then
	cval => eval_tree%root%cval
	else
	cval => null ()
	end if
	end function eval_tree_get_cmplx_ptr

	function eval_tree_get_subevt_ptr (eval_tree) result (pval)
	type(subevt_t), pointer :: pval
	type(eval_tree_t), intent(in) :: eval_tree
	if (associated (eval_tree%root)) then
	pval => eval_tree%root%pval
	else
	pval => null ()
	end if
	end function eval_tree_get_subevt_ptr

	function eval_tree_get_pdg_array_ptr (eval_tree) result (aval)
	type(pdg_array_t), pointer :: aval
	type(eval_tree_t), intent(in) :: eval_tree
	if (associated (eval_tree%root)) then
	aval => eval_tree%root%aval
	else
	aval => null ()
	end if
	end function eval_tree_get_pdg_array_ptr

	function eval_tree_get_string_ptr (eval_tree) result (sval)
	type(string_t), pointer :: sval
	type(eval_tree_t), intent(in) :: eval_tree
	if (associated (eval_tree%root)) then
	sval => eval_tree%root%sval
	else
	sval => null ()
	end if
	end function eval_tree_get_string_ptr

	@ %def eval_tree_get_log_ptr eval_tree_get_int_ptr eval_tree_get_real_ptr
	@ %def eval_tree_get_cmplx_ptr
	@ %def eval_tree_get_subevt_ptr eval_tree_get_pdg_array_ptr
	@ %def eval_tree_get_string_ptr
	<<Eval trees: eval tree: TBP>>=
	procedure :: write => eval_tree_write
	<<Eval trees: sub interfaces>>=
	module subroutine eval_tree_write (expr, unit, write_vars)
	class(eval_tree_t), intent(in) :: expr
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: write_vars
	end subroutine eval_tree_write
	<<Eval trees: procedures>>=
	module subroutine eval_tree_write (expr, unit, write_vars)
	class(eval_tree_t), intent(in) :: expr
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: write_vars
	integer :: u
	logical :: vl
	u = given_output_unit (unit); if (u < 0) return
	vl = .false.; if (present (write_vars)) vl = write_vars
	write (u, "(1x,A)") "Evaluation tree:"
	if (associated (expr%root)) then
	call eval_node_write_rec (expr%root, unit)
	else
	write (u, "(3x,A)") "[empty]"
	end if
	if (vl) call expr%var_list%write (unit)
	end subroutine eval_tree_write

	@ %def eval_tree_write
	@ Use the written representation for generating an MD5 sum:
	<<Eval trees: procedures>>=
	function eval_tree_get_md5sum (eval_tree) result (md5sum_et)
	character(32) :: md5sum_et
	type(eval_tree_t), intent(in) :: eval_tree
	integer :: u
	u = free_unit ()
	open (unit = u, status = "scratch", action = "readwrite")
	call eval_tree_write (eval_tree, unit=u)
	rewind (u)
	md5sum_et = md5sum (u)
	close (u)
	end function eval_tree_get_md5sum

	@ %def eval_tree_get_md5sum
	@
	\subsection{Direct evaluation}
	These procedures create an eval tree and evaluate it on-the-fly, returning
	only the final value. The evaluation must yield a well-defined value, unless
	the [[is_known]] flag is present, which will be set accordingly.
	<<Eval trees: public>>=
	public :: eval_log
	public :: eval_int
	public :: eval_real
	public :: eval_cmplx
	public :: eval_subevt
	public :: eval_pdg_array
	public :: eval_string
	<<Eval trees: sub interfaces>>=
	module function eval_log &
	(parse_node, var_list, subevt, is_known) result (lval)
	logical :: lval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	end function eval_log
	module function eval_int &
	(parse_node, var_list, subevt, is_known) result (ival)
	integer :: ival
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	end function eval_int
	module function eval_real &
	(parse_node, var_list, subevt, is_known) result (rval)
	real(default) :: rval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	end function eval_real
	module function eval_cmplx &
	(parse_node, var_list, subevt, is_known) result (cval)
	complex(default) :: cval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	end function eval_cmplx
	module function eval_subevt &
	(parse_node, var_list, subevt, is_known) result (pval)
	type(subevt_t) :: pval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	end function eval_subevt
	module function eval_pdg_array &
	(parse_node, var_list, subevt, is_known) result (aval)
	type(pdg_array_t) :: aval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	end function eval_pdg_array
	module function eval_string &
	(parse_node, var_list, subevt, is_known) result (sval)
	type(string_t) :: sval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	end function eval_string
	<<Eval trees: procedures>>=
	module function eval_log &
	(parse_node, var_list, subevt, is_known) result (lval)
	logical :: lval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	type(eval_tree_t), target :: eval_tree
	call eval_tree_init_lexpr &
	(eval_tree, parse_node, var_list, subevt)
	call eval_tree_evaluate (eval_tree)
	if (eval_tree_result_is_known (eval_tree)) then
	if (present (is_known)) is_known = .true.
	lval = eval_tree_get_log (eval_tree)
	else if (present (is_known)) then
	is_known = .false.
	else
	call eval_tree_unknown (eval_tree, parse_node)
	lval = .false.
	end if
	call eval_tree_final (eval_tree)
	end function eval_log

	module function eval_int &
	(parse_node, var_list, subevt, is_known) result (ival)
	integer :: ival
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	type(eval_tree_t), target :: eval_tree
	call eval_tree_init_expr &
	(eval_tree, parse_node, var_list, subevt)
	call eval_tree_evaluate (eval_tree)
	if (eval_tree_result_is_known (eval_tree)) then
	if (present (is_known)) is_known = .true.
	ival = eval_tree_get_int (eval_tree)
	else if (present (is_known)) then
	is_known = .false.
	else
	call eval_tree_unknown (eval_tree, parse_node)
	ival = 0
	end if
	call eval_tree_final (eval_tree)
	end function eval_int

	module function eval_real &
	(parse_node, var_list, subevt, is_known) result (rval)
	real(default) :: rval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	type(eval_tree_t), target :: eval_tree
	call eval_tree_init_expr &
	(eval_tree, parse_node, var_list, subevt)
	call eval_tree_evaluate (eval_tree)
	if (eval_tree_result_is_known (eval_tree)) then
	if (present (is_known)) is_known = .true.
	rval = eval_tree_get_real (eval_tree)
	else if (present (is_known)) then
	is_known = .false.
	else
	call eval_tree_unknown (eval_tree, parse_node)
	rval = 0
	end if
	call eval_tree_final (eval_tree)
	end function eval_real

	module function eval_cmplx &
	(parse_node, var_list, subevt, is_known) result (cval)
	complex(default) :: cval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	type(eval_tree_t), target :: eval_tree
	call eval_tree_init_expr &
	(eval_tree, parse_node, var_list, subevt)
	call eval_tree_evaluate (eval_tree)
	if (eval_tree_result_is_known (eval_tree)) then
	if (present (is_known)) is_known = .true.
	cval = eval_tree_get_cmplx (eval_tree)
	else if (present (is_known)) then
	is_known = .false.
	else
	call eval_tree_unknown (eval_tree, parse_node)
	cval = 0
	end if
	call eval_tree_final (eval_tree)
	end function eval_cmplx

	module function eval_subevt &
	(parse_node, var_list, subevt, is_known) result (pval)
	type(subevt_t) :: pval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	type(eval_tree_t), target :: eval_tree
	call eval_tree_init_pexpr &
	(eval_tree, parse_node, var_list, subevt)
	call eval_tree_evaluate (eval_tree)
	if (eval_tree_result_is_known (eval_tree)) then
	if (present (is_known)) is_known = .true.
	pval = eval_tree_get_subevt (eval_tree)
	else if (present (is_known)) then
	is_known = .false.
	else
	call eval_tree_unknown (eval_tree, parse_node)
	end if
	call eval_tree_final (eval_tree)
	end function eval_subevt

	module function eval_pdg_array &
	(parse_node, var_list, subevt, is_known) result (aval)
	type(pdg_array_t) :: aval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	type(eval_tree_t), target :: eval_tree
	call eval_tree_init_cexpr &
	(eval_tree, parse_node, var_list, subevt)
	call eval_tree_evaluate (eval_tree)
	if (eval_tree_result_is_known (eval_tree)) then
	if (present (is_known)) is_known = .true.
	aval = eval_tree_get_pdg_array (eval_tree)
	else if (present (is_known)) then
	is_known = .false.
	else
	call eval_tree_unknown (eval_tree, parse_node)
	end if
	call eval_tree_final (eval_tree)
	end function eval_pdg_array

	module function eval_string &
	(parse_node, var_list, subevt, is_known) result (sval)
	type(string_t) :: sval
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	logical, intent(out), optional :: is_known
	type(eval_tree_t), target :: eval_tree
	call eval_tree_init_sexpr &
	(eval_tree, parse_node, var_list, subevt)
	call eval_tree_evaluate (eval_tree)
	if (eval_tree_result_is_known (eval_tree)) then
	if (present (is_known)) is_known = .true.
	sval = eval_tree_get_string (eval_tree)
	else if (present (is_known)) then
	is_known = .false.
	else
	call eval_tree_unknown (eval_tree, parse_node)
	sval = ""
	end if
	call eval_tree_final (eval_tree)
	end function eval_string

	@ %def eval_log eval_int eval_real eval_cmplx
	@ %def eval_subevt eval_pdg_array eval_string
	@ %def eval_tree_unknown
	@ Here is a variant that returns numeric values of all possible kinds, the
	appropriate kind to be selected later:
	<<Eval trees: public>>=
	public :: eval_numeric
	<<Eval trees: sub interfaces>>=
	module subroutine eval_numeric &
	(parse_node, var_list, subevt, ival, rval, cval, &
	is_known, result_type)
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	integer, intent(out), optional :: ival
	real(default), intent(out), optional :: rval
	complex(default), intent(out), optional :: cval
	logical, intent(out), optional :: is_known
	integer, intent(out), optional :: result_type
	end subroutine eval_numeric
	<<Eval trees: procedures>>=
	module subroutine eval_numeric &
	(parse_node, var_list, subevt, ival, rval, cval, &
	is_known, result_type)
	type(parse_node_t), intent(in), target :: parse_node
	type(var_list_t), intent(in), target :: var_list
	type(subevt_t), intent(in), optional, target :: subevt
	integer, intent(out), optional :: ival
	real(default), intent(out), optional :: rval
	complex(default), intent(out), optional :: cval
	logical, intent(out), optional :: is_known
	integer, intent(out), optional :: result_type
	type(eval_tree_t), target :: eval_tree
	call eval_tree_init_expr &
	(eval_tree, parse_node, var_list, subevt)
	call eval_tree_evaluate (eval_tree)
	if (eval_tree_result_is_known (eval_tree)) then
	if (present (ival)) ival = eval_tree_get_int (eval_tree)
	if (present (rval)) rval = eval_tree_get_real (eval_tree)
	if (present (cval)) cval = eval_tree_get_cmplx (eval_tree)
	if (present (is_known)) is_known = .true.
	else
	call eval_tree_unknown (eval_tree, parse_node)
	if (present (ival)) ival = 0
	if (present (rval)) rval = 0
	if (present (cval)) cval = 0
	if (present (is_known)) is_known = .false.
	end if
	if (present (result_type)) &
	result_type = eval_tree_get_result_type (eval_tree)
	call eval_tree_final (eval_tree)
	end subroutine eval_numeric

	@ %def eval_numeric
	@ Error message with debugging info:
	<<Eval trees: procedures>>=
	subroutine eval_tree_unknown (eval_tree, parse_node)
	type(eval_tree_t), intent(in) :: eval_tree
	type(parse_node_t), intent(in) :: parse_node
	call parse_node_write_rec (parse_node)
	call eval_tree_write (eval_tree)
	call msg_error ("Evaluation yields an undefined result, inserting default")
	end subroutine eval_tree_unknown

	@ %def eval_tree_unknown
	@
	\subsection{Factory Type}
	Since [[eval_tree_t]] is an implementation of [[expr_t]], we also need a
	matching factory type and build method.
	<<Eval trees: public>>=
	public :: eval_tree_factory_t
	<<Eval trees: types>>=
	type, extends (expr_factory_t) :: eval_tree_factory_t
	private
	type(parse_node_t), pointer :: pn => null ()
	contains
	<<Eval trees: eval tree factory: TBP>>
	end type eval_tree_factory_t

	@ %def eval_tree_factory_t
	@ Output: delegate to the output of the embedded parse node.
	<<Eval trees: eval tree factory: TBP>>=
	procedure :: write => eval_tree_factory_write
	<<Eval trees: sub interfaces>>=
	module subroutine eval_tree_factory_write (expr_factory, unit)
	class(eval_tree_factory_t), intent(in) :: expr_factory
	integer, intent(in), optional :: unit
	end subroutine eval_tree_factory_write
	<<Eval trees: procedures>>=
	module subroutine eval_tree_factory_write (expr_factory, unit)
	class(eval_tree_factory_t), intent(in) :: expr_factory
	integer, intent(in), optional :: unit
	if (associated (expr_factory%pn)) then
	call parse_node_write_rec (expr_factory%pn, unit)
	end if
	end subroutine eval_tree_factory_write

	@ %def eval_tree_factory_write
	@ Initializer: take a parse node and hide it thus from the environment.
	<<Eval trees: eval tree factory: TBP>>=
	procedure :: init => eval_tree_factory_init
	<<Eval trees: sub interfaces>>=
	module subroutine eval_tree_factory_init (expr_factory, pn)
	class(eval_tree_factory_t), intent(out) :: expr_factory
	type(parse_node_t), intent(in), pointer :: pn
	end subroutine eval_tree_factory_init
	<<Eval trees: procedures>>=
	module subroutine eval_tree_factory_init (expr_factory, pn)
	class(eval_tree_factory_t), intent(out) :: expr_factory
	type(parse_node_t), intent(in), pointer :: pn
	expr_factory%pn => pn
	end subroutine eval_tree_factory_init

	@ %def eval_tree_factory_init
	@ Factory method: allocate expression with correct eval tree type. If the
	stored parse node is not associate, don't allocate.
	Gfortran 7/8/9 bug, has to remain in the module.
	<<Eval trees: eval tree factory: TBP>>=
	procedure :: build => eval_tree_factory_build
	<<Eval trees: main procedures>>=
	subroutine eval_tree_factory_build (expr_factory, expr)
	class(eval_tree_factory_t), intent(in) :: expr_factory
	class(expr_t), intent(out), allocatable :: expr
	if (associated (expr_factory%pn)) then
	allocate (eval_tree_t :: expr)
	select type (expr)
	type is (eval_tree_t)
	expr%pn => expr_factory%pn
	end select
	end if
	end subroutine eval_tree_factory_build

	@ %def eval_tree_factory_build
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[eval_trees_ut.f90]]>>=
	<<File header>>

	module eval_trees_ut
	use unit_tests
	use eval_trees_uti

	<<Standard module head>>

	<<Eval trees: public test>>

	contains

	<<Eval trees: test driver>>

	end module eval_trees_ut
	@ %def eval_trees_ut
	@
	<<[[eval_trees_uti.f90]]>>=
	<<File header>>

	module eval_trees_uti

	<<Use kinds>>
	<<Use strings>>

	use ifiles
	use lexers
	use lorentz
	use syntax_rules, only: syntax_write
	use pdg_arrays
	use subevents
	use variables
	use observables

	use eval_trees

	<<Standard module head>>

	<<Eval trees: test declarations>>

	contains

	<<Eval trees: tests>>

	end module eval_trees_uti
	@ %def eval_trees_ut
	@ API: driver for the unit tests below.
	<<Eval trees: public test>>=
	public :: expressions_test
	<<Eval trees: test driver>>=
	subroutine expressions_test (u, results)
	integer, intent(in) :: u
	type (test_results_t), intent(inout) :: results
	<<Eval trees: execute tests>>
	end subroutine expressions_test

	@ %def expressions_test
	@ Testing the routines of the expressions module. First a simple unary
	observable and the node evaluation.
	<<Eval trees: execute tests>>=
	call test (expressions_1, "expressions_1", &
	"check simple observable", &
	u, results)
	<<Eval trees: test declarations>>=
	public :: expressions_1
	<<Eval trees: tests>>=
	subroutine expressions_1 (u)
	integer, intent(in) :: u
	type(var_list_t), pointer :: var_list => null ()
	type(eval_node_t), pointer :: node => null ()
	type(prt_t), pointer :: prt => null ()
	type(string_t) :: var_name

	write (u, "(A)") "* Test output: Expressions"
	write (u, "(A)") "* Purpose: test simple observable and node evaluation"
	write (u, "(A)")

	write (u, "(A)") "* Setting a unary observable:"
	write (u, "(A)")

	allocate (var_list)
	allocate (prt)
	call var_list_set_observables_unary (var_list, prt)
	call var_list%write (u)

	write (u, "(A)") "* Evaluating the observable node:"
	write (u, "(A)")

	var_name = "PDG"

	allocate (node)
	call node%test_obs (var_list, var_name)
	call node%write (u)

	write (u, "(A)") "* Cleanup"
	write (u, "(A)")

	call node%final_rec ()
	deallocate (node)
	!!! Workaround for NAGFOR 6.2
	! call var_list%final ()
	deallocate (var_list)
	deallocate (prt)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: expressions_1"

	end subroutine expressions_1

	@ %def expressions_1
	@ Parse a complicated expression, transfer it to a parse tree and evaluate.
	<<Eval trees: execute tests>>=
	call test (expressions_2, "expressions_2", &
	"check expression transfer to parse tree", &
	u, results)
	<<Eval trees: test declarations>>=
	public :: expressions_2
	<<Eval trees: tests>>=
	subroutine expressions_2 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(eval_tree_t) :: eval_tree
	type(string_t) :: expr_text
	type(var_list_t), pointer :: var_list => null ()

	write (u, "(A)") "* Test output: Expressions"
	write (u, "(A)") "* Purpose: test parse routines"
	write (u, "(A)")

	call syntax_expr_init ()
	call syntax_write (syntax_expr, u)
	allocate (var_list)
	call var_list%append_real (var_str ("tolerance"), 0._default)
	call var_list%append_real (var_str ("x"), -5._default)
	call var_list%append_int (var_str ("foo"), -27)
	call var_list%append_real (var_str ("mb"), 4._default)
	expr_text = &
	"let real twopi = 2 * pi in" // &
	" twopi * sqrt (25.d0 - mb^2)" // &
	" / (let int mb_or_0 = max (mb, 0) in" // &
	" 1 + (if -1 TeV <= x < mb_or_0 then abs(x) else x endif))"
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call var_list%write (u)
	call eval_tree%init_stream (stream, var_list=var_list)
	call eval_tree%evaluate ()
	call eval_tree%write (u)

	write (u, "(A)") "* Input string:"
	write (u, "(A,A)") " ", char (expr_text)
	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call stream_final (stream)
	call ifile_final (ifile)
	call eval_tree%final ()
	call var_list%final ()
	deallocate (var_list)
	call syntax_expr_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: expressions_2"

	end subroutine expressions_2

	@ %def expressions_2
	@ Test a subevent expression.
	<<Eval trees: execute tests>>=
	call test (expressions_3, "expressions_3", &
	"check subevent expressions", &
	u, results)
	<<Eval trees: test declarations>>=
	public :: expressions_3
	<<Eval trees: tests>>=
	subroutine expressions_3 (u)
	integer, intent(in) :: u
	type(subevt_t) :: subevt

	write (u, "(A)") "* Test output: Expressions"
	write (u, "(A)") "* Purpose: test subevent expressions"
	write (u, "(A)")

	write (u, "(A)") "* Initialize subevent:"
	write (u, "(A)")

	call subevt_init (subevt)
	call subevt%reset (1)
	call subevt%set_incoming (1, 22, &
	vector4_moving (1.e3_default, 1.e3_default, 1), 0._default, [2])
	call subevt%write (u)
	call subevt%reset (4)
	call subevt%reset (3)
	call subevt%set_incoming (1, 21, &
	vector4_moving (1.e3_default, 1.e3_default, 3), 0._default, [1])
	call subevt_polarize (subevt, 1, -1)
	call subevt%set_outgoing (2, 1, &
	vector4_moving (0._default, 1.e3_default, 3), &
	-1.e6_default, [7])
	call subevt%set_composite (3, &
	vector4_moving (-1.e3_default, 0._default, 3), [2, 7])
	call subevt%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: expressions_3"

	end subroutine expressions_3

	@ %def expressions_3
	@ Test expressions from a PDG array.
	<<Eval trees: execute tests>>=
	call test (expressions_4, "expressions_4", &
	"check pdg array expressions", &
	u, results)
	<<Eval trees: test declarations>>=
	public :: expressions_4
	<<Eval trees: tests>>=
	subroutine expressions_4 (u)
	integer, intent(in) :: u
	type(subevt_t), target :: subevt
	type(string_t) :: expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(eval_tree_t) :: eval_tree
	type(var_list_t), pointer :: var_list => null ()
	type(pdg_array_t) :: aval

	write (u, "(A)") "* Test output: Expressions"
	write (u, "(A)") "* Purpose: test pdg array expressions"
	write (u, "(A)")

	write (u, "(A)") "* Initialization:"
	write (u, "(A)")

	call syntax_pexpr_init ()
	call syntax_write (syntax_pexpr, u)
	allocate (var_list)
	call var_list%append_real (var_str ("tolerance"), 0._default)
	aval = 0
	call var_list%append_pdg_array (var_str ("particle"), aval)
	aval = [11,-11]
	call var_list%append_pdg_array (var_str ("lepton"), aval)
	aval = 22
	call var_list%append_pdg_array (var_str ("photon"), aval)
	aval = 1
	call var_list%append_pdg_array (var_str ("u"), aval)
	call subevt_init (subevt)
	call subevt%reset (6)
	call subevt%set_incoming (1, 1, &
	vector4_moving (1._default, 1._default, 1), 0._default)
	call subevt%set_incoming (2, -1, &
	vector4_moving (2._default, 2._default, 1), 0._default)
	call subevt%set_outgoing (3, 22, &
	vector4_moving (3._default, 3._default, 1), 0._default)
	call subevt%set_outgoing (4, 22, &
	vector4_moving (4._default, 4._default, 1), 0._default)
	call subevt%set_outgoing (5, 11, &
	vector4_moving (5._default, 5._default, 1), 0._default)
	call subevt%set_outgoing (6, -11, &
	vector4_moving (6._default, 6._default, 1), 0._default)
	write (u, "(A)")
	write (u, "(A)") "* Expression:"
	expr_text = &
	"let alias quark = pdg(1):pdg(2):pdg(3) in" // &
	" any E > 3 GeV " // &
	" [sort by - Pt " // &
	" [select if Index < 6 " // &
	" [photon:pdg(-11):pdg(3):quark " // &
	" & incoming particle]]]" // &
	" and" // &
	" eval Theta [extract index -1 [photon]] > 45 degree" // &
	" and" // &
	" count [incoming photon] * 3 > 0"
	write (u, "(A,A)") " ", char (expr_text)
	write (u, "(A)")

	write (u, "(A)")
	write (u, "(A)") "* Extract the evaluation tree:"
	write (u, "(A)")

	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call eval_tree%init_stream (stream, var_list, subevt, V_LOG)
	call eval_tree%write (u)
	call eval_tree%evaluate ()

	write (u, "(A)")
	write (u, "(A)") "* Evaluate the tree:"
	write (u, "(A)")

	call eval_tree%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"
	write (u, "(A)")

	call stream_final (stream)
	call ifile_final (ifile)
	call eval_tree%final ()
	call var_list%final ()
	deallocate (var_list)
	call syntax_pexpr_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: expressions_4"

	end subroutine expressions_4

	@ %def expressions_4
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Physics Models}

	A model object represents a physics model. It contains a table of particle
	data, a list of parameters, and a vertex table. The list of parameters is a
	variable list which includes the real parameters (which are pointers to the
	particle data table) and PDG array variables for the particles themselves.
	The vertex list is used for phase-space generation, not for calculating the
	matrix element.

	The actual numeric model data are in the base type [[model_data_t]],
	as part of the [[qft]] section. We implement the [[model_t]] as an
	extension of this, for convenient direct access to the base-type
	methods via inheritance. (Alternatively, we could delegate these calls
	explicitly.) The extension contains administrative additions, such as
	the methods for recalculating derived data and keeping the parameter
	set consistent. It thus acts as a proxy of the actual model-data
	object towards the \whizard\ package. There are further proxy
	objects, such as the [[parameter_t]] array which provides the
	interface to the actual numeric parameters.

	Model definitions are read from model files. Therefore, this module contains
	a parser for model files. The parameter definitions (derived parameters) are
	Sindarin expressions.

	The models, as read from file, are stored in a model library which is a simple
	list of model definitions. For setting up a process object we should make a
	copy (an instance) of a model, which gets the current parameter values from
	the global variable list.

	\subsection{Module}
	<<[[models.f90]]>>=
	<<File header>>

	module models

	use, intrinsic :: iso_c_binding !NODEP!

	<<Use kinds>>
	use kinds, only: c_default_float
	<<Use strings>>
	use os_interface
	use model_data

	use syntax_rules
	use parser
	use variables
	use expr_base
	use eval_trees

	<<Standard module head>>

	<<Models: public>>

	<<Models: parameters>>

	<<Models: types>>

	<<Models: interfaces>>

	<<Models: variables>>

	interface
	<<Models: sub interfaces>>
	end interface

	contains

	<<Models: main procedures>>

	end module models
	@ %def models
	@
	<<[[models_sub.f90]]>>=
	<<File header>>

	submodule (models) models_s

	use io_units
	use diagnostics
	use md5
	use physics_defs, only: UNDEFINED

	use ifiles
	use lexers
	use pdg_arrays
	use ttv_formfactors, only: init_parameters

	implicit none

	contains

	<<Models: procedures>>

	end submodule models_s

	@ %def models_s
	@
	\subsection{Physics Parameters}
	A parameter has a name, a value. Derived parameters also have a
	definition in terms of other parameters, which is stored as an
	[[eval_tree]]. External parameters are set by an external program.

	This parameter object should be considered as a proxy object. The
	parameter name and value are stored in a corresponding
	[[modelpar_data_t]] object which is located in a [[model_data_t]]
	object. The latter is a component of the [[model_t]] handler.
	Methods of [[parameter_t]] can be delegated to the [[par_data_t]]
	component.

	The [[block_name]] and [[block_index]] values, if nonempty, indicate
	the possibility of reading this parameter from a SLHA-type input file.
	(Within the [[parameter_t]] object, this info is just used for I/O,
	the actual block register is located in the parent [[model_t]]
	object.)

	The [[pn]] component is a pointer to the parameter definition inside the
	model parse tree. It allows us to recreate the [[eval_tree]] when making
	copies (instances) of the parameter object.
	<<Models: parameters>>=
	integer, parameter :: PAR_NONE = 0, PAR_UNUSED = -1
	integer, parameter :: PAR_INDEPENDENT = 1, PAR_DERIVED = 2
	integer, parameter :: PAR_EXTERNAL = 3

	@ %def PAR_NONE PAR_INDEPENDENT PAR_DERIVED PAR_EXTERNAL PAR_UNUSED
	<<Models: types>>=
	type :: parameter_t
	private
	integer :: type = PAR_NONE
	class(modelpar_data_t), pointer :: data => null ()
	type(string_t) :: block_name
	integer, dimension(:), allocatable :: block_index
	type(parse_node_t), pointer :: pn => null ()
	class(expr_t), allocatable :: expr
	contains
	<<Models: parameter: TBP>>
	end type parameter_t

	@ %def parameter_t
	@ Initialization depends on parameter type. Independent parameters
	are initialized by a constant value or a constant numerical expression
	(which may contain a unit). Derived parameters are initialized by an
	arbitrary numerical expression, which makes use of the current
	variable list. The expression is evaluated by the function
	[[parameter_reset]].

	This implementation supports only real parameters and real values.
	<<Models: parameter: TBP>>=
	procedure :: init_independent_value => parameter_init_independent_value
	procedure :: init_independent => parameter_init_independent
	procedure :: init_derived => parameter_init_derived
	procedure :: init_external => parameter_init_external
	procedure :: init_unused => parameter_init_unused
	<<Models: sub interfaces>>=
	module subroutine parameter_init_independent_value &
	(par, par_data, name, value)
	class(parameter_t), intent(out) :: par
	class(modelpar_data_t), intent(in), target :: par_data
	type(string_t), intent(in) :: name
	real(default), intent(in) :: value
	end subroutine parameter_init_independent_value
	module subroutine parameter_init_external (par, par_data, name)
	class(parameter_t), intent(out) :: par
	class(modelpar_data_t), intent(in), target :: par_data
	type(string_t), intent(in) :: name
	end subroutine parameter_init_external
	module subroutine parameter_init_unused (par, par_data, name)
	class(parameter_t), intent(out) :: par
	class(modelpar_data_t), intent(in), target :: par_data
	type(string_t), intent(in) :: name
	end subroutine parameter_init_unused
	<<Models: procedures>>=
	module subroutine parameter_init_independent_value &
	(par, par_data, name, value)
	class(parameter_t), intent(out) :: par
	class(modelpar_data_t), intent(in), target :: par_data
	type(string_t), intent(in) :: name
	real(default), intent(in) :: value
	par%type = PAR_INDEPENDENT
	par%data => par_data
	- call par%data%init (name, value)
	+ call par%data%init (name, value, .true.)
	end subroutine parameter_init_independent_value

	module subroutine parameter_init_external (par, par_data, name)
	class(parameter_t), intent(out) :: par
	class(modelpar_data_t), intent(in), target :: par_data
	type(string_t), intent(in) :: name
	par%type = PAR_EXTERNAL
	par%data => par_data
	call par%data%init (name, 0._default)
	end subroutine parameter_init_external

	module subroutine parameter_init_unused (par, par_data, name)
	class(parameter_t), intent(out) :: par
	class(modelpar_data_t), intent(in), target :: par_data
	type(string_t), intent(in) :: name
	par%type = PAR_UNUSED
	par%data => par_data
	call par%data%init (name, 0._default)
	end subroutine parameter_init_unused

	@ %def parameter_init_independent_value
	@ %def parameter_init_external
	@ %def parameter_init_unused
	@ Gfortran 7/8/9 bug: these have to remain in the main module.
	<<Models: main procedures>>=
	subroutine parameter_init_independent (par, par_data, name, pn)
	class(parameter_t), intent(out) :: par
	class(modelpar_data_t), intent(in), target :: par_data
	type(string_t), intent(in) :: name
	type(parse_node_t), intent(in), target :: pn
	par%type = PAR_INDEPENDENT
	par%pn => pn
	allocate (eval_tree_t :: par%expr)
	select type (expr => par%expr)
	type is (eval_tree_t)
	call expr%init_numeric_value (pn)
	end select
	par%data => par_data
	- call par%data%init (name, par%expr%get_real ())
	+ call par%data%init (name, par%expr%get_real (), .true.)
	end subroutine parameter_init_independent

	subroutine parameter_init_derived (par, par_data, name, pn, var_list)
	class(parameter_t), intent(out) :: par
	class(modelpar_data_t), intent(in), target :: par_data
	type(string_t), intent(in) :: name
	type(parse_node_t), intent(in), target :: pn
	type(var_list_t), intent(in), target :: var_list
	par%type = PAR_DERIVED
	par%pn => pn
	allocate (eval_tree_t :: par%expr)
	select type (expr => par%expr)
	type is (eval_tree_t)
	call expr%init_expr (pn, var_list=var_list)
	end select
	par%data => par_data
	! call par%expr%evaluate ()
	call par%data%init (name, 0._default)
	end subroutine parameter_init_derived

	@ %def parameter_init_independent
	@ %def parameter_init_derived
	@ The finalizer is needed for the evaluation tree in the definition.
	<<Models: parameter: TBP>>=
	procedure :: final => parameter_final
	<<Models: sub interfaces>>=
	module subroutine parameter_final (par)
	class(parameter_t), intent(inout) :: par
	end subroutine parameter_final
	<<Models: procedures>>=
	module subroutine parameter_final (par)
	class(parameter_t), intent(inout) :: par
	if (allocated (par%expr)) then
	call par%expr%final ()
	end if
	end subroutine parameter_final

	@ %def parameter_final
	@ All derived parameters should be recalculated if some independent
	parameters have changed:
	<<Models: parameter: TBP>>=
	procedure :: reset_derived => parameter_reset_derived
	<<Models: sub interfaces>>=
	module subroutine parameter_reset_derived (par)
	class(parameter_t), intent(inout) :: par
	end subroutine parameter_reset_derived
	<<Models: procedures>>=
	module subroutine parameter_reset_derived (par)
	class(parameter_t), intent(inout) :: par
	select case (par%type)
	case (PAR_DERIVED)
	call par%expr%evaluate ()
	par%data = par%expr%get_real ()
	end select
	end subroutine parameter_reset_derived

	@ %def parameter_reset_derived parameter_reset_external
	@ Output. [We should have a formula format for the eval tree,
	suitable for input and output!]
	<<Models: parameter: TBP>>=
	procedure :: write => parameter_write
	<<Models: sub interfaces>>=
	module subroutine parameter_write (par, unit, write_defs)
	class(parameter_t), intent(in) :: par
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: write_defs
	end subroutine parameter_write
	<<Models: procedures>>=
	module subroutine parameter_write (par, unit, write_defs)
	class(parameter_t), intent(in) :: par
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: write_defs
	logical :: defs
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	defs = .false.; if (present (write_defs)) defs = write_defs
	select case (par%type)
	case (PAR_INDEPENDENT)
	write (u, "(3x,A)", advance="no") "parameter"
	call par%data%write (u)
	case (PAR_DERIVED)
	write (u, "(3x,A)", advance="no") "derived"
	call par%data%write (u)
	case (PAR_EXTERNAL)
	write (u, "(3x,A)", advance="no") "external"
	call par%data%write (u)
	case (PAR_UNUSED)
	write (u, "(3x,A)", advance="no") "unused"
	write (u, "(1x,A)", advance="no") char (par%data%get_name ())
	end select
	select case (par%type)
	case (PAR_INDEPENDENT)
	if (allocated (par%block_index)) then
	write (u, "(1x,A,1x,A,*(1x,I0))") &
	"slha_entry", char (par%block_name), par%block_index
	else
	write (u, "(A)")
	end if
	case (PAR_DERIVED)
	if (defs) then
	call par%expr%write (unit)
	else
	write (u, "(A)")
	end if
	case default
	write (u, "(A)")
	end select
	end subroutine parameter_write

	@ %def parameter_write
	@ Screen output variant. Restrict output to the given parameter type.
	<<Models: parameter: TBP>>=
	procedure :: show => parameter_show
	<<Models: sub interfaces>>=
	module subroutine parameter_show (par, l, u, partype)
	class(parameter_t), intent(in) :: par
	integer, intent(in) :: l, u
	integer, intent(in) :: partype
	end subroutine parameter_show
	<<Models: procedures>>=
	module subroutine parameter_show (par, l, u, partype)
	class(parameter_t), intent(in) :: par
	integer, intent(in) :: l, u
	integer, intent(in) :: partype
	if (par%type == partype) then
	call par%data%show (l, u)
	end if
	end subroutine parameter_show

	@ %def parameter_show
	@
	\subsection{SLHA block register}
	For the optional SLHA interface, the model record contains a register
	of SLHA-type block names together with index values, which point to a
	particular parameter. These are private types:
	<<Models: types>>=
	type :: slha_entry_t
	integer, dimension(:), allocatable :: block_index
	integer :: i_par = 0
	end type slha_entry_t

	@ %def slha_entry_t
	<<Models: types>>=
	type :: slha_block_t
	type(string_t) :: name
	integer :: n_entry = 0
	type(slha_entry_t), dimension(:), allocatable :: entry
	end type slha_block_t

	@ %def slha_block_t
	@
	\subsection{Model Object}
	A model object holds all information about parameters, particles,
	and vertices. For models that require an external program for
	parameter calculation, there is the pointer to a function that does
	this calculation, given the set of independent and derived parameters.

	As explained above, the type inherits from [[model_data_t]], which is
	the actual storage for the model data.

	When reading a model, we create a parse tree. Parameter definitions are
	available via parse nodes. Since we may need those later when making model
	instances, we keep the whole parse tree in the model definition (but not in
	the instances).
	<<Models: public>>=
	public :: model_t
	<<Models: types>>=
	type, extends (model_data_t) :: model_t
	private
	character(32) :: md5sum = ""
	logical :: ufo_model = .false.
	type(string_t) :: ufo_path
	type(string_t), dimension(:), allocatable :: schemes
	type(string_t), allocatable :: selected_scheme
	type(parameter_t), dimension(:), allocatable :: par
	integer :: n_slha_block = 0
	type(slha_block_t), dimension(:), allocatable :: slha_block
	integer :: max_par_name_length = 0
	integer :: max_field_name_length = 0
	type(var_list_t) :: var_list
	type(string_t) :: dlname
	procedure(model_init_external_parameters), nopass, pointer :: &
	init_external_parameters => null ()
	type(dlaccess_t) :: dlaccess
	type(parse_tree_t) :: parse_tree
	contains
	<<Models: model: TBP>>
	end type model_t

	@ %def model_t
	@ This is the interface for a procedure that initializes the
	calculation of external parameters, given the array of all
	parameters.
	<<Models: interfaces>>=
	abstract interface
	subroutine model_init_external_parameters (par) bind (C)
	import
	real(c_default_float), dimension(*), intent(inout) :: par
	end subroutine model_init_external_parameters
	end interface

	@ %def model_init_external_parameters
	@ Initialization: Specify the number of parameters, particles,
	vertices and allocate memory. If an associated DL library is
	specified, load this library.

	The model may already carry scheme information, so we have to save and
	restore the scheme number when actually initializing the [[model_data_t]]
	base.
	<<Models: model: TBP>>=
	generic :: init => model_init
	procedure, private :: model_init
	<<Models: sub interfaces>>=
	module subroutine model_init &
	(model, name, libname, os_data, n_par, n_prt, n_vtx, ufo)
	class(model_t), intent(inout) :: model
	type(string_t), intent(in) :: name, libname
	type(os_data_t), intent(in) :: os_data
	integer, intent(in) :: n_par, n_prt, n_vtx
	logical, intent(in), optional :: ufo
	end subroutine model_init
	<<Models: procedures>>=
	module subroutine model_init &
	(model, name, libname, os_data, n_par, n_prt, n_vtx, ufo)
	class(model_t), intent(inout) :: model
	type(string_t), intent(in) :: name, libname
	type(os_data_t), intent(in) :: os_data
	integer, intent(in) :: n_par, n_prt, n_vtx
	logical, intent(in), optional :: ufo
	type(c_funptr) :: c_fptr
	type(string_t) :: libpath
	integer :: scheme_num
	scheme_num = model%get_scheme_num ()
	- call model%basic_init (name, n_par, n_prt, n_vtx)
	- if (present (ufo)) model%ufo_model = ufo
	+ if (present (ufo)) then
	+ model%ufo_model = ufo
	+ call model%basic_init (name, n_par, n_prt, n_vtx, model%ufo_path)
	+ else
	+ call model%basic_init (name, n_par, n_prt, n_vtx)
	+ end if
	call model%set_scheme_num (scheme_num)
	if (libname /= "") then
	if (.not. os_data%use_testfiles) then
	libpath = os_data%whizard_models_libpath_local
	model%dlname = os_get_dlname ( &
	libpath // "/" // libname, os_data, ignore=.true.)
	end if
	if (model%dlname == "") then
	libpath = os_data%whizard_models_libpath
	model%dlname = os_get_dlname (libpath // "/" // libname, os_data)
	end if
	else
	model%dlname = ""
	end if
	if (model%dlname /= "") then
	if (.not. dlaccess_is_open (model%dlaccess)) then
	if (logging) &
	call msg_message ("Loading model auxiliary library '" &
	// char (libpath) // "/" // char (model%dlname) // "'")
	call dlaccess_init (model%dlaccess, os_data%whizard_models_libpath, &
	model%dlname, os_data)
	if (dlaccess_has_error (model%dlaccess)) then
	call msg_message (char (dlaccess_get_error (model%dlaccess)))
	call msg_fatal ("Loading model auxiliary library '" &
	// char (model%dlname) // "' failed")
	return
	end if
	c_fptr = dlaccess_get_c_funptr (model%dlaccess, &
	var_str ("init_external_parameters"))
	if (dlaccess_has_error (model%dlaccess)) then
	call msg_message (char (dlaccess_get_error (model%dlaccess)))
	call msg_fatal ("Loading function from auxiliary library '" &
	// char (model%dlname) // "' failed")
	return
	end if
	call c_f_procpointer (c_fptr, model% init_external_parameters)
	end if
	end if
	end subroutine model_init

	@ %def model_init
	@ For a model instance, we do not attempt to load a DL library. This is the
	core of the full initializer above.
	<<Models: model: TBP>>=
	procedure, private :: basic_init => model_basic_init
	<<Models: sub interfaces>>=
	- module subroutine model_basic_init (model, name, n_par, n_prt, n_vtx)
	+ module subroutine model_basic_init (model, name, n_par, n_prt, n_vtx, ufo_path)
	class(model_t), intent(inout) :: model
	type(string_t), intent(in) :: name
	integer, intent(in) :: n_par, n_prt, n_vtx
	+ type(string_t), optional :: ufo_path
	end subroutine model_basic_init
	<<Models: procedures>>=
	- module subroutine model_basic_init (model, name, n_par, n_prt, n_vtx)
	+ module subroutine model_basic_init (model, name, n_par, n_prt, n_vtx, ufo_path)
	class(model_t), intent(inout) :: model
	type(string_t), intent(in) :: name
	integer, intent(in) :: n_par, n_prt, n_vtx
	+ type(string_t), optional :: ufo_path
	allocate (model%par (n_par))
	- call model%model_data_t%init (name, n_par, 0, n_prt, n_vtx)
	+ call model%model_data_t%init (name, n_par, 0, n_prt, n_vtx, ufo_path)
	end subroutine model_basic_init

	@ %def model_basic_init
	@ Finalization: The variable list contains allocated pointers, also the parse
	tree. We also close the DL access object, if any, that enables external
	parameter calculation.
	<<Models: model: TBP>>=
	procedure :: final => model_final
	<<Models: sub interfaces>>=
	module subroutine model_final (model)
	class(model_t), intent(inout) :: model
	end subroutine model_final
	<<Models: procedures>>=
	module subroutine model_final (model)
	class(model_t), intent(inout) :: model
	integer :: i
	if (allocated (model%par)) then
	do i = 1, size (model%par)
	call model%par(i)%final ()
	end do
	end if
	call model%var_list%final (follow_link=.false.)
	if (model%dlname /= "") call dlaccess_final (model%dlaccess)
	call parse_tree_final (model%parse_tree)
	call model%model_data_t%final ()
	end subroutine model_final

	@ %def model_final
	@ Output. By default, the output is in the form of an input file. If
	[[verbose]] is true, for each derived parameter the definition (eval
	tree) is displayed, and the vertex hash table is shown.
	<<Models: model: TBP>>=
	procedure :: write => model_write
	<<Models: sub interfaces>>=
	module subroutine model_write (model, unit, verbose, &
	show_md5sum, show_variables, show_parameters, &
	show_particles, show_vertices, show_scheme)
	class(model_t), intent(in) :: model
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: show_md5sum
	logical, intent(in), optional :: show_variables
	logical, intent(in), optional :: show_parameters
	logical, intent(in), optional :: show_particles
	logical, intent(in), optional :: show_vertices
	logical, intent(in), optional :: show_scheme
	end subroutine model_write
	<<Models: procedures>>=
	module subroutine model_write (model, unit, verbose, &
	show_md5sum, show_variables, show_parameters, &
	show_particles, show_vertices, show_scheme)
	class(model_t), intent(in) :: model
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: show_md5sum
	logical, intent(in), optional :: show_variables
	logical, intent(in), optional :: show_parameters
	logical, intent(in), optional :: show_particles
	logical, intent(in), optional :: show_vertices
	logical, intent(in), optional :: show_scheme
	logical :: verb, show_md5, show_par, show_var
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	verb = .false.; if (present (verbose)) verb = verbose
	show_md5 = .true.; if (present (show_md5sum)) &
	show_md5 = show_md5sum
	show_par = .true.; if (present (show_parameters)) &
	show_par = show_parameters
	show_var = verb; if (present (show_variables)) &
	show_var = show_variables
	write (u, "(A,A,A)") 'model "', char (model%get_name ()), '"'
	if (show_md5 .and. model%md5sum /= "") &
	write (u, "(1x,A,A,A)") "! md5sum = '", model%md5sum, "'"
	if (model%is_ufo_model ()) then
	write (u, "(1x,A)") "! model derived from UFO source"
	else if (model%has_schemes ()) then
	write (u, "(1x,A)", advance="no") "! schemes ="
	do i = 1, size (model%schemes)
	if (i > 1) write (u, "(',')", advance="no")
	write (u, "(1x,A,A,A)", advance="no") &
	"'", char (model%schemes(i)), "'"
	end do
	write (u, *)
	if (allocated (model%selected_scheme)) then
	write (u, "(1x,A,A,A,I0,A)") &
	"! selected scheme = '", char (model%get_scheme ()), &
	"' (", model%get_scheme_num (), ")"
	end if
	end if
	if (show_par) then
	write (u, "(A)")
	do i = 1, size (model%par)
	call model%par(i)%write (u, write_defs=verbose)
	end do
	end if
	call model%model_data_t%write (unit, verbose, &
	show_md5sum, show_variables, &
	show_parameters=.false., &
	show_particles=show_particles, &
	show_vertices=show_vertices, &
	show_scheme=show_scheme)
	if (show_var) then
	write (u, "(A)")
	call model%var_list%write (unit, follow_link=.false.)
	end if
	end subroutine model_write

	@ %def model_write
	@ Screen output, condensed form.
	<<Models: model: TBP>>=
	procedure :: show => model_show
	<<Models: sub interfaces>>=
	module subroutine model_show (model, unit)
	class(model_t), intent(in) :: model
	integer, intent(in), optional :: unit
	end subroutine model_show
	<<Models: procedures>>=
	module subroutine model_show (model, unit)
	class(model_t), intent(in) :: model
	integer, intent(in), optional :: unit
	integer :: i, u, l
	u = given_output_unit (unit)
	write (u, "(A,1x,A)") "Model:", char (model%get_name ())
	if (model%has_schemes ()) then
	write (u, "(2x,A,A,A,I0,A)") "Scheme: '", &
	char (model%get_scheme ()), "' (", model%get_scheme_num (), ")"
	end if
	l = model%max_field_name_length
	call model%show_fields (l, u)
	l = model%max_par_name_length
	if (any (model%par%type == PAR_INDEPENDENT)) then
	write (u, "(2x,A)") "Independent parameters:"
	do i = 1, size (model%par)
	call model%par(i)%show (l, u, PAR_INDEPENDENT)
	end do
	end if
	if (any (model%par%type == PAR_DERIVED)) then
	write (u, "(2x,A)") "Derived parameters:"
	do i = 1, size (model%par)
	call model%par(i)%show (l, u, PAR_DERIVED)
	end do
	end if
	if (any (model%par%type == PAR_EXTERNAL)) then
	write (u, "(2x,A)") "External parameters:"
	do i = 1, size (model%par)
	call model%par(i)%show (l, u, PAR_EXTERNAL)
	end do
	end if
	if (any (model%par%type == PAR_UNUSED)) then
	write (u, "(2x,A)") "Unused parameters:"
	do i = 1, size (model%par)
	call model%par(i)%show (l, u, PAR_UNUSED)
	end do
	end if
	end subroutine model_show

	@ %def model_show
	@ Show all fields/particles.
	<<Models: model: TBP>>=
	procedure :: show_fields => model_show_fields
	<<Models: sub interfaces>>=
	module subroutine model_show_fields (model, l, unit)
	class(model_t), intent(in), target :: model
	integer, intent(in) :: l
	integer, intent(in), optional :: unit
	end subroutine model_show_fields
	<<Models: procedures>>=
	module subroutine model_show_fields (model, l, unit)
	class(model_t), intent(in), target :: model
	integer, intent(in) :: l
	integer, intent(in), optional :: unit
	type(field_data_t), pointer :: field
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(2x,A)") "Particles:"
	do i = 1, model%get_n_field ()
	field => model%get_field_ptr_by_index (i)
	call field%show (l, u)
	end do
	end subroutine model_show_fields

	@ %def model_data_show_fields
	@ Show the list of stable, unstable, polarized, or unpolarized
	particles, respectively.
	<<Models: model: TBP>>=
	procedure :: show_stable => model_show_stable
	procedure :: show_unstable => model_show_unstable
	procedure :: show_polarized => model_show_polarized
	procedure :: show_unpolarized => model_show_unpolarized
	<<Models: sub interfaces>>=
	module subroutine model_show_stable (model, unit)
	class(model_t), intent(in), target :: model
	integer, intent(in), optional :: unit
	end subroutine model_show_stable
	module subroutine model_show_unstable (model, unit)
	class(model_t), intent(in), target :: model
	integer, intent(in), optional :: unit
	end subroutine model_show_unstable
	module subroutine model_show_polarized (model, unit)
	class(model_t), intent(in), target :: model
	integer, intent(in), optional :: unit
	end subroutine model_show_polarized
	module subroutine model_show_unpolarized (model, unit)
	class(model_t), intent(in), target :: model
	integer, intent(in), optional :: unit
	end subroutine model_show_unpolarized
	<<Models: procedures>>=
	module subroutine model_show_stable (model, unit)
	class(model_t), intent(in), target :: model
	integer, intent(in), optional :: unit
	type(field_data_t), pointer :: field
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(A,1x)", advance="no") "Stable particles:"
	do i = 1, model%get_n_field ()
	field => model%get_field_ptr_by_index (i)
	if (field%is_stable (.false.)) then
	write (u, "(1x,A)", advance="no") char (field%get_name (.false.))
	end if
	if (field%has_antiparticle ()) then
	if (field%is_stable (.true.)) then
	write (u, "(1x,A)", advance="no") char (field%get_name (.true.))
	end if
	end if
	end do
	write (u, *)
	end subroutine model_show_stable

	module subroutine model_show_unstable (model, unit)
	class(model_t), intent(in), target :: model
	integer, intent(in), optional :: unit
	type(field_data_t), pointer :: field
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(A,1x)", advance="no") "Unstable particles:"
	do i = 1, model%get_n_field ()
	field => model%get_field_ptr_by_index (i)
	if (.not. field%is_stable (.false.)) then
	write (u, "(1x,A)", advance="no") char (field%get_name (.false.))
	end if
	if (field%has_antiparticle ()) then
	if (.not. field%is_stable (.true.)) then
	write (u, "(1x,A)", advance="no") char (field%get_name (.true.))
	end if
	end if
	end do
	write (u, *)
	end subroutine model_show_unstable

	module subroutine model_show_polarized (model, unit)
	class(model_t), intent(in), target :: model
	integer, intent(in), optional :: unit
	type(field_data_t), pointer :: field
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(A,1x)", advance="no") "Polarized particles:"
	do i = 1, model%get_n_field ()
	field => model%get_field_ptr_by_index (i)
	if (field%is_polarized (.false.)) then
	write (u, "(1x,A)", advance="no") char (field%get_name (.false.))
	end if
	if (field%has_antiparticle ()) then
	if (field%is_polarized (.true.)) then
	write (u, "(1x,A)", advance="no") char (field%get_name (.true.))
	end if
	end if
	end do
	write (u, *)
	end subroutine model_show_polarized

	module subroutine model_show_unpolarized (model, unit)
	class(model_t), intent(in), target :: model
	integer, intent(in), optional :: unit
	type(field_data_t), pointer :: field
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(A,1x)", advance="no") "Unpolarized particles:"
	do i = 1, model%get_n_field ()
	field => model%get_field_ptr_by_index (i)
	if (.not. field%is_polarized (.false.)) then
	write (u, "(1x,A)", advance="no") &
	char (field%get_name (.false.))
	end if
	if (field%has_antiparticle ()) then
	if (.not. field%is_polarized (.true.)) then
	write (u, "(1x,A)", advance="no") char (field%get_name (.true.))
	end if
	end if
	end do
	write (u, *)
	end subroutine model_show_unpolarized

	@ %def model_show_stable
	@ %def model_show_unstable
	@ %def model_show_polarized
	@ %def model_show_unpolarized
	@ Retrieve the MD5 sum of a model (actually, of the model file).
	<<Models: model: TBP>>=
	procedure :: get_md5sum => model_get_md5sum
	<<Models: sub interfaces>>=
	module function model_get_md5sum (model) result (md5sum)
	character(32) :: md5sum
	class(model_t), intent(in) :: model
	end function model_get_md5sum
	<<Models: procedures>>=
	module function model_get_md5sum (model) result (md5sum)
	character(32) :: md5sum
	class(model_t), intent(in) :: model
	md5sum = model%md5sum
	end function model_get_md5sum

	@ %def model_get_md5sum
	@ Parameters are defined by an expression which may be constant or
	arbitrary.
	<<Models: model: TBP>>=
	procedure :: &
	set_parameter_constant => model_set_parameter_constant
	procedure, private :: &
	set_parameter_parse_node => model_set_parameter_parse_node
	procedure :: &
	set_parameter_external => model_set_parameter_external
	procedure :: &
	set_parameter_unused => model_set_parameter_unused
	<<Models: sub interfaces>>=
	module subroutine model_set_parameter_constant (model, i, name, value)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	real(default), intent(in) :: value
	end subroutine model_set_parameter_constant
	module subroutine model_set_parameter_parse_node &
	(model, i, name, pn, constant)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	type(parse_node_t), intent(in), target :: pn
	logical, intent(in) :: constant
	end subroutine model_set_parameter_parse_node
	module subroutine model_set_parameter_external (model, i, name)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	end subroutine model_set_parameter_external
	module subroutine model_set_parameter_unused (model, i, name)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	end subroutine model_set_parameter_unused
	<<Models: procedures>>=
	module subroutine model_set_parameter_constant (model, i, name, value)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	real(default), intent(in) :: value
	logical, save, target :: known = .true.
	class(modelpar_data_t), pointer :: par_data
	real(default), pointer :: value_ptr
	par_data => model%get_par_real_ptr (i)
	call model%par(i)%init_independent_value (par_data, name, value)
	value_ptr => par_data%get_real_ptr ()
	call model%var_list%append_real_ptr (name, value_ptr, &
	is_known=known, intrinsic=.true.)
	model%max_par_name_length = max (model%max_par_name_length, len (name))
	end subroutine model_set_parameter_constant

	module subroutine model_set_parameter_parse_node &
	(model, i, name, pn, constant)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	type(parse_node_t), intent(in), target :: pn
	logical, intent(in) :: constant
	logical, save, target :: known = .true.
	class(modelpar_data_t), pointer :: par_data
	real(default), pointer :: value_ptr
	par_data => model%get_par_real_ptr (i)
	if (constant) then
	call model%par(i)%init_independent (par_data, name, pn)
	else
	call model%par(i)%init_derived (par_data, name, pn, model%var_list)
	end if
	value_ptr => par_data%get_real_ptr ()
	call model%var_list%append_real_ptr (name, value_ptr, &
	is_known=known, locked=.not.constant, intrinsic=.true.)
	model%max_par_name_length = max (model%max_par_name_length, len (name))
	end subroutine model_set_parameter_parse_node

	module subroutine model_set_parameter_external (model, i, name)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	logical, save, target :: known = .true.
	class(modelpar_data_t), pointer :: par_data
	real(default), pointer :: value_ptr
	par_data => model%get_par_real_ptr (i)
	call model%par(i)%init_external (par_data, name)
	value_ptr => par_data%get_real_ptr ()
	call model%var_list%append_real_ptr (name, value_ptr, &
	is_known=known, locked=.true., intrinsic=.true.)
	model%max_par_name_length = max (model%max_par_name_length, len (name))
	end subroutine model_set_parameter_external

	module subroutine model_set_parameter_unused (model, i, name)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name
	class(modelpar_data_t), pointer :: par_data
	par_data => model%get_par_real_ptr (i)
	call model%par(i)%init_unused (par_data, name)
	call model%var_list%append_real (name, locked=.true., intrinsic=.true.)
	model%max_par_name_length = max (model%max_par_name_length, len (name))
	end subroutine model_set_parameter_unused

	@ %def model_set_parameter
	@ Make a copy of a parameter. We assume that the [[model_data_t]]
	parameter arrays have already been copied, so names and values are
	available in the current model, and can be used as targets. The eval
	tree should not be copied, since it should refer to the new variable
	list. The safe solution is to make use of the above initializers,
	which also take care of the building a new variable list.
	<<Models: model: TBP>>=
	procedure, private :: copy_parameter => model_copy_parameter
	<<Models: sub interfaces>>=
	module subroutine model_copy_parameter (model, i, par)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parameter_t), intent(in) :: par
	end subroutine model_copy_parameter
	<<Models: procedures>>=
	module subroutine model_copy_parameter (model, i, par)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parameter_t), intent(in) :: par
	type(string_t) :: name
	real(default) :: value
	name = par%data%get_name ()
	select case (par%type)
	case (PAR_INDEPENDENT)
	if (associated (par%pn)) then
	call model%set_parameter_parse_node (i, name, par%pn, &
	constant = .true.)
	else
	value = par%data%get_real ()
	call model%set_parameter_constant (i, name, value)
	end if
	if (allocated (par%block_index)) then
	model%par(i)%block_name = par%block_name
	model%par(i)%block_index = par%block_index
	end if
	case (PAR_DERIVED)
	call model%set_parameter_parse_node (i, name, par%pn, &
	constant = .false.)
	case (PAR_EXTERNAL)
	call model%set_parameter_external (i, name)
	case (PAR_UNUSED)
	call model%set_parameter_unused (i, name)
	end select
	end subroutine model_copy_parameter

	@ %def model_copy_parameter
	@ Recalculate all derived parameters.
	<<Models: model: TBP>>=
	procedure :: update_parameters => model_parameters_update
	<<Models: sub interfaces>>=
	module subroutine model_parameters_update (model)
	class(model_t), intent(inout) :: model
	end subroutine model_parameters_update
	<<Models: procedures>>=
	module subroutine model_parameters_update (model)
	class(model_t), intent(inout) :: model
	integer :: i
	real(default), dimension(:), allocatable :: par
	do i = 1, size (model%par)
	call model%par(i)%reset_derived ()
	end do
	if (associated (model%init_external_parameters)) then
	allocate (par (model%get_n_real ()))
	call model%real_parameters_to_c_array (par)
	call model%init_external_parameters (par)
	call model%real_parameters_from_c_array (par)
	if (model%get_name() == var_str ("SM_tt_threshold")) &
	call set_threshold_parameters ()
	end if
	contains
	subroutine set_threshold_parameters ()
	real(default) :: mpole, wtop
	!!! !!! !!! Workaround for OS-X and BSD which do not load
	!!! !!! !!! the global values created previously. Therefore
	!!! !!! !!! a second initialization for the threshold model,
	!!! !!! !!! where M1S is required to compute the top mass.
	call init_parameters (mpole, wtop, &
	par(20), par(21), par(22), &
	par(19), par(39), par(4), par(1), &
	par(2), par(10), par(24), par(25), &
	par(23), par(26), par(27), par(29), &
	par(30), par(31), par(32), par(33), &
	par(36) > 0._default, par(28))
	end subroutine set_threshold_parameters
	end subroutine model_parameters_update

	@ %def model_parameters_update
	@ Initialize field data with PDG long name and PDG code.
	<<Models: model: TBP>>=
	procedure, private :: init_field => model_init_field
	<<Models: sub interfaces>>=
	module subroutine model_init_field (model, i, longname, pdg)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: longname
	integer, intent(in) :: pdg
	end subroutine model_init_field
	<<Models: procedures>>=
	module subroutine model_init_field (model, i, longname, pdg)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: longname
	integer, intent(in) :: pdg
	type(field_data_t), pointer :: field
	field => model%get_field_ptr_by_index (i)
	call field%init (longname, pdg)
	end subroutine model_init_field

	@ %def model_init_field
	@ Copy field data for index [[i]] from another particle which serves
	as a template. The name should be the unique long name.
	<<Models: model: TBP>>=
	procedure, private :: copy_field => model_copy_field
	<<Models: sub interfaces>>=
	module subroutine model_copy_field (model, i, name_src)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name_src
	end subroutine model_copy_field
	<<Models: procedures>>=
	module subroutine model_copy_field (model, i, name_src)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(string_t), intent(in) :: name_src
	type(field_data_t), pointer :: field_src, field
	field_src => model%get_field_ptr (name_src)
	field => model%get_field_ptr_by_index (i)
	call field%copy_from (field_src)
	end subroutine model_copy_field

	@ %def model_copy_field
	@
	\subsection{Model Access via Variables}
	Write the model variable list.
	<<Models: model: TBP>>=
	procedure :: write_var_list => model_write_var_list
	<<Models: sub interfaces>>=
	module subroutine model_write_var_list (model, unit, follow_link)
	class(model_t), intent(in) :: model
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: follow_link
	end subroutine model_write_var_list
	<<Models: procedures>>=
	module subroutine model_write_var_list (model, unit, follow_link)
	class(model_t), intent(in) :: model
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: follow_link
	call model%var_list%write (unit, follow_link)
	end subroutine model_write_var_list

	@ %def model_write_var_list
	@ Link a variable list to the model variables.
	<<Models: model: TBP>>=
	procedure :: link_var_list => model_link_var_list
	<<Models: sub interfaces>>=
	module subroutine model_link_var_list (model, var_list)
	class(model_t), intent(inout) :: model
	type(var_list_t), intent(in), target :: var_list
	end subroutine model_link_var_list
	<<Models: procedures>>=
	module subroutine model_link_var_list (model, var_list)
	class(model_t), intent(inout) :: model
	type(var_list_t), intent(in), target :: var_list
	call model%var_list%link (var_list)
	end subroutine model_link_var_list

	@ %def model_link_var_list
	@
	Check if the model contains a named variable.
	<<Models: model: TBP>>=
	procedure :: var_exists => model_var_exists
	<<Models: sub interfaces>>=
	module function model_var_exists (model, name) result (flag)
	class(model_t), intent(in) :: model
	type(string_t), intent(in) :: name
	logical :: flag
	end function model_var_exists
	<<Models: procedures>>=
	module function model_var_exists (model, name) result (flag)
	class(model_t), intent(in) :: model
	type(string_t), intent(in) :: name
	logical :: flag
	flag = model%var_list%contains (name, follow_link=.false.)
	end function model_var_exists

	@ %def model_var_exists
	@ Check if the model variable is a derived parameter, i.e., locked.
	<<Models: model: TBP>>=
	procedure :: var_is_locked => model_var_is_locked
	<<Models: sub interfaces>>=
	module function model_var_is_locked (model, name) result (flag)
	class(model_t), intent(in) :: model
	type(string_t), intent(in) :: name
	logical :: flag
	end function model_var_is_locked
	<<Models: procedures>>=
	module function model_var_is_locked (model, name) result (flag)
	class(model_t), intent(in) :: model
	type(string_t), intent(in) :: name
	logical :: flag
	flag = model%var_list%is_locked (name, follow_link=.false.)
	end function model_var_is_locked

	@ %def model_var_is_locked
	@ Set a model parameter via the named variable. We assume that the
	variable exists and is writable, i.e., non-locked. We update the
	model and variable list, so independent and derived parameters are
	always synchronized.
	<<Models: model: TBP>>=
	procedure :: set_real => model_var_set_real
	<<Models: sub interfaces>>=
	module subroutine model_var_set_real (model, name, rval, verbose, pacified)
	class(model_t), intent(inout) :: model
	type(string_t), intent(in) :: name
	real(default), intent(in) :: rval
	logical, intent(in), optional :: verbose, pacified
	end subroutine model_var_set_real
	<<Models: procedures>>=
	module subroutine model_var_set_real (model, name, rval, verbose, pacified)
	class(model_t), intent(inout) :: model
	type(string_t), intent(in) :: name
	real(default), intent(in) :: rval
	logical, intent(in), optional :: verbose, pacified
	call model%var_list%set_real (name, rval, &
	is_known=.true., ignore=.false., &
	verbose=verbose, model_name=model%get_name (), pacified=pacified)
	call model%update_parameters ()
	end subroutine model_var_set_real

	@ %def model_var_set_real
	@ Retrieve a model parameter value.
	<<Models: model: TBP>>=
	procedure :: get_rval => model_var_get_rval
	<<Models: sub interfaces>>=
	module function model_var_get_rval (model, name) result (rval)
	class(model_t), intent(in) :: model
	type(string_t), intent(in) :: name
	real(default) :: rval
	end function model_var_get_rval
	<<Models: procedures>>=
	module function model_var_get_rval (model, name) result (rval)
	class(model_t), intent(in) :: model
	type(string_t), intent(in) :: name
	real(default) :: rval
	rval = model%var_list%get_rval (name, follow_link=.false.)
	end function model_var_get_rval

	@ %def model_var_get_rval
	@
	[To be deleted] Return a pointer to the variable list.
	<<Models: model: TBP>>=
	procedure :: get_var_list_ptr => model_get_var_list_ptr
	<<Models: sub interfaces>>=
	module function model_get_var_list_ptr (model) result (var_list)
	type(var_list_t), pointer :: var_list
	class(model_t), intent(in), target :: model
	end function model_get_var_list_ptr
	<<Models: procedures>>=
	module function model_get_var_list_ptr (model) result (var_list)
	type(var_list_t), pointer :: var_list
	class(model_t), intent(in), target :: model
	var_list => model%var_list
	end function model_get_var_list_ptr

	@ %def model_get_var_list_ptr
	@
	\subsection{UFO models}
	A single flag identifies a model as a UFO model. There is no other
	distinction, but the flag allows us to handle built-in and UFO models
	with the same name in parallel.
	<<Models: model: TBP>>=
	procedure :: is_ufo_model => model_is_ufo_model
	<<Models: sub interfaces>>=
	module function model_is_ufo_model (model) result (flag)
	class(model_t), intent(in) :: model
	logical :: flag
	end function model_is_ufo_model
	<<Models: procedures>>=
	module function model_is_ufo_model (model) result (flag)
	class(model_t), intent(in) :: model
	logical :: flag
	flag = model%ufo_model
	end function model_is_ufo_model

	@ %def model_is_ufo_model
	@ Return the UFO path used for fetching the UFO source.
	<<Models: model: TBP>>=
	procedure :: get_ufo_path => model_get_ufo_path
	<<Models: sub interfaces>>=
	module function model_get_ufo_path (model) result (path)
	class(model_t), intent(in) :: model
	type(string_t) :: path
	end function model_get_ufo_path
	<<Models: procedures>>=
	module function model_get_ufo_path (model) result (path)
	class(model_t), intent(in) :: model
	type(string_t) :: path
	if (model%ufo_model) then
	path = model%ufo_path
	else
	path = ""
	end if
	end function model_get_ufo_path

	@ %def model_get_ufo_path
	@
	Call OMega and generate a model file from an UFO source file. We
	start with a file name; the model name is expected to be the base
	name, stripping extensions.

	The path search either takes [[ufo_path_requested]], or searches first
	in the working directory, then in a hard-coded UFO model directory.
	<<Models: procedures>>=
	subroutine model_generate_ufo (filename, os_data, ufo_path, &
	ufo_path_requested)
	type(string_t), intent(in) :: filename
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(out) :: ufo_path
	type(string_t), intent(in), optional :: ufo_path_requested
	type(string_t) :: model_name, omega_path, ufo_dir, ufo_init
	logical :: exist
	call get_model_name (filename, model_name)
	call msg_message ("Model: Generating model '" // char (model_name) &
	// "' from UFO sources")
	if (present (ufo_path_requested)) then
	call msg_message ("Model: Searching for UFO sources in '" &
	// char (ufo_path_requested) // "'")
	ufo_path = ufo_path_requested
	ufo_dir = ufo_path_requested // "/" // model_name
	ufo_init = ufo_dir // "/" // "__init__.py"
	inquire (file = char (ufo_init), exist = exist)
	else
	call msg_message ("Model: Searching for UFO sources in &
	&working directory")
	ufo_path = "."
	ufo_dir = ufo_path // "/" // model_name
	ufo_init = ufo_dir // "/" // "__init__.py"
	inquire (file = char (ufo_init), exist = exist)
	if (.not. exist) then
	ufo_path = char (os_data%whizard_modelpath_ufo)
	ufo_dir = ufo_path // "/" // model_name
	ufo_init = ufo_dir // "/" // "__init__.py"
	call msg_message ("Model: Searching for UFO sources in '" &
	// char (os_data%whizard_modelpath_ufo) // "'")
	inquire (file = char (ufo_init), exist = exist)
	end if
	end if
	if (exist) then
	call msg_message ("Model: Found UFO sources for model '" &
	// char (model_name) // "'")
	else
	call msg_fatal ("Model: UFO sources for model '" &
	// char (model_name) // "' not found")
	end if
	omega_path = os_data%whizard_omega_binpath // "/omega_UFO.opt"
	call os_system_call (omega_path &
	// " -model:UFO_dir " // ufo_dir &
	// " -model:exec" &
	// " -model:write_WHIZARD" &
	// " > " // filename)
	inquire (file = char (filename), exist = exist)
	if (exist) then
	call msg_message ("Model: Model file '" // char (filename) //&
	"' generated")
	else
	call msg_fatal ("Model: Model file '" // char (filename) &
	// "' could not be generated")
	end if
	contains
	subroutine get_model_name (filename, model_name)
	type(string_t), intent(in) :: filename
	type(string_t), intent(out) :: model_name
	type(string_t) :: string
	string = filename
	call split (string, model_name, ".")
	end subroutine get_model_name
	end subroutine model_generate_ufo

	@ %def model_generate_ufo
	@
	\subsection{Scheme handling}
	A model can specify a set of allowed schemes that steer the setup of
	model variables. The model file can contain scheme-specific
	declarations that are selected by a [[select scheme]] clause. Scheme
	support is optional.

	If enabled, the model object contains a list of allowed schemes, and
	the model reader takes the active scheme as an argument. After the
	model has been read, the scheme is fixed and can no longer be
	modified.

	The model supports schemes if the scheme array is allocated.
	<<Models: model: TBP>>=
	procedure :: has_schemes => model_has_schemes
	<<Models: sub interfaces>>=
	module function model_has_schemes (model) result (flag)
	logical :: flag
	class(model_t), intent(in) :: model
	end function model_has_schemes
	<<Models: procedures>>=
	module function model_has_schemes (model) result (flag)
	logical :: flag
	class(model_t), intent(in) :: model
	flag = allocated (model%schemes)
	end function model_has_schemes

	@ %def model_has_schemes
	@
	Enable schemes: fix the list of allowed schemes.
	<<Models: model: TBP>>=
	procedure :: enable_schemes => model_enable_schemes
	<<Models: sub interfaces>>=
	module subroutine model_enable_schemes (model, scheme)
	class(model_t), intent(inout) :: model
	type(string_t), dimension(:), intent(in) :: scheme
	end subroutine model_enable_schemes
	<<Models: procedures>>=
	module subroutine model_enable_schemes (model, scheme)
	class(model_t), intent(inout) :: model
	type(string_t), dimension(:), intent(in) :: scheme
	allocate (model%schemes (size (scheme)), source = scheme)
	end subroutine model_enable_schemes

	@ %def model_enable_schemes
	@
	Find the scheme. Check if the scheme is allowed. The numeric index of the
	selected scheme is stored in the [[model_data_t]] base object.

	If no argument is given,
	select the first scheme. The numeric scheme ID will then be $1$, while a
	model without schemes retains $0$.
	<<Models: model: TBP>>=
	procedure :: set_scheme => model_set_scheme
	<<Models: sub interfaces>>=
	module subroutine model_set_scheme (model, scheme)
	class(model_t), intent(inout) :: model
	type(string_t), intent(in), optional :: scheme
	end subroutine model_set_scheme
	<<Models: procedures>>=
	module subroutine model_set_scheme (model, scheme)
	class(model_t), intent(inout) :: model
	type(string_t), intent(in), optional :: scheme
	logical :: ok
	integer :: i
	if (model%has_schemes ()) then
	if (present (scheme)) then
	ok = .false.
	CHECK_SCHEME: do i = 1, size (model%schemes)
	if (scheme == model%schemes(i)) then
	allocate (model%selected_scheme, source = scheme)
	call model%set_scheme_num (i)
	ok = .true.
	exit CHECK_SCHEME
	end if
	end do CHECK_SCHEME
	if (.not. ok) then
	call msg_fatal &
	("Model '" // char (model%get_name ()) &
	// "': scheme '" // char (scheme) // "' not supported")
	end if
	else
	allocate (model%selected_scheme, source = model%schemes(1))
	call model%set_scheme_num (1)
	end if
	else
	if (present (scheme)) then
	call msg_error &
	("Model '" // char (model%get_name ()) &
	// "' does not support schemes")
	end if
	end if
	end subroutine model_set_scheme

	@ %def model_set_scheme
	@
	Get the scheme. Note that the base [[model_data_t]] provides a
	[[get_scheme_num]] getter function.
	<<Models: model: TBP>>=
	procedure :: get_scheme => model_get_scheme
	<<Models: sub interfaces>>=
	module function model_get_scheme (model) result (scheme)
	class(model_t), intent(in) :: model
	type(string_t) :: scheme
	end function model_get_scheme
	<<Models: procedures>>=
	module function model_get_scheme (model) result (scheme)
	class(model_t), intent(in) :: model
	type(string_t) :: scheme
	if (allocated (model%selected_scheme)) then
	scheme = model%selected_scheme
	else
	scheme = ""
	end if
	end function model_get_scheme

	@ %def model_get_scheme
	@
	Check if a model has been set up with a specific name and (if
	applicable) scheme. This helps in determining whether we need a new
	model object.

	A UFO model is considered to be distinct from a non-UFO model. We assume that
	if [[ufo]] is asked for, there is no scheme argument. Furthermore,
	if there is an [[ufo_path]] requested, it must coincide with the
	[[ufo_path]] of the model. If not, the model [[ufo_path]] is not checked.
	<<Models: model: TBP>>=
	procedure :: matches => model_matches
	<<Models: sub interfaces>>=
	module function model_matches &
	(model, name, scheme, ufo, ufo_path) result (flag)
	logical :: flag
	class(model_t), intent(in) :: model
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	end function model_matches
	<<Models: procedures>>=
	module function model_matches &
	(model, name, scheme, ufo, ufo_path) result (flag)
	logical :: flag
	class(model_t), intent(in) :: model
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	logical :: ufo_model
	ufo_model = .false.; if (present (ufo)) ufo_model = ufo
	if (name /= model%get_name ()) then
	flag = .false.
	else if (ufo_model .neqv. model%is_ufo_model ()) then
	flag = .false.
	else if (ufo_model) then
	if (present (ufo_path)) then
	flag = model%get_ufo_path () == ufo_path
	else
	flag = .true.
	end if
	else if (model%has_schemes ()) then
	if (present (scheme)) then
	flag = model%get_scheme () == scheme
	else
	flag = model%get_scheme_num () == 1
	end if
	else if (present (scheme)) then
	flag = .false.
	else
	flag = .true.
	end if
	end function model_matches

	@ %def model_matches
	@
	\subsection{SLHA-type interface}
	Abusing the original strict SUSY Les Houches Accord (SLHA), we support
	reading parameter data from some custom SLHA-type input file. To this
	end, the [[model]] object stores a list of model-specific block names
	together with information how to find a parameter in the model record,
	given a block name and index vector.

	Check if the model supports custom SLHA block info. This is the case
	if [[n_slha_block]] is nonzero, i.e., after SLHA block names have been
	parsed and registered.
	<<Models: model: TBP>>=
	procedure :: supports_custom_slha => model_supports_custom_slha
	<<Models: sub interfaces>>=
	module function model_supports_custom_slha (model) result (flag)
	class(model_t), intent(in) :: model
	logical :: flag
	end function model_supports_custom_slha
	<<Models: procedures>>=
	module function model_supports_custom_slha (model) result (flag)
	class(model_t), intent(in) :: model
	logical :: flag

	flag = model%n_slha_block > 0

	end function model_supports_custom_slha

	@ %def model_supports_custom_slha
	@ Return the block names for all SLHA block references.
	<<Models: model: TBP>>=
	procedure :: get_custom_slha_blocks => model_get_custom_slha_blocks
	<<Models: sub interfaces>>=
	module subroutine model_get_custom_slha_blocks (model, block_name)
	class(model_t), intent(in) :: model
	type(string_t), dimension(:), allocatable :: block_name
	end subroutine model_get_custom_slha_blocks
	<<Models: procedures>>=
	module subroutine model_get_custom_slha_blocks (model, block_name)
	class(model_t), intent(in) :: model
	type(string_t), dimension(:), allocatable :: block_name

	integer :: i

	allocate (block_name (model%n_slha_block))
	do i = 1, size (block_name)
	block_name(i) = model%slha_block(i)%name
	end do

	end subroutine model_get_custom_slha_blocks

	@ %def model_get_custom_slha_blocks
	@
	This routine registers a SLHA block reference. We have the index of a
	(new) parameter entry and a parse node from the model file which
	specifies a block name and an index array.
	<<Models: procedures>>=
	subroutine model_record_slha_block_entry (model, i_par, node)
	class(model_t), intent(inout) :: model
	integer, intent(in) :: i_par
	type(parse_node_t), intent(in), target :: node

	type(parse_node_t), pointer :: node_block_name, node_index
	type(string_t) :: block_name
	integer :: n_index, i, i_block
	integer, dimension(:), allocatable :: block_index

	node_block_name => node%get_sub_ptr (2)
	select case (char (node_block_name%get_rule_key ()))
	case ("block_name")
	block_name = node_block_name%get_string ()
	case ("QNUMBERS")
	block_name = "QNUMBERS"
	case default
	block_name = node_block_name%get_string ()
	end select
	n_index = node%get_n_sub () - 2
	allocate (block_index (n_index))
	node_index => node_block_name%get_next_ptr ()
	do i = 1, n_index
	block_index(i) = node_index%get_integer ()
	node_index => node_index%get_next_ptr ()
	end do
	i_block = 0
	FIND_BLOCK: do i = 1, model%n_slha_block
	if (model%slha_block(i)%name == block_name) then
	i_block = i
	exit FIND_BLOCK
	end if
	end do FIND_BLOCK
	if (i_block == 0) then
	call model_add_slha_block (model, block_name)
	i_block = model%n_slha_block
	end if
	associate (b => model%slha_block(i_block))
	call add_slha_block_entry (b, block_index, i_par)
	end associate
	model%par(i_par)%block_name = block_name
	model%par(i_par)%block_index = block_index
	end subroutine model_record_slha_block_entry

	@ %def model_record_slha_block_entry
	@ Add a new entry to the SLHA block register, increasing the array
	size if necessary
	<<Models: procedures>>=
	subroutine model_add_slha_block (model, block_name)
	class(model_t), intent(inout) :: model
	type(string_t), intent(in) :: block_name

	if (.not. allocated (model%slha_block)) allocate (model%slha_block (1))
	if (model%n_slha_block == size (model%slha_block)) call grow
	model%n_slha_block = model%n_slha_block + 1
	associate (b => model%slha_block(model%n_slha_block))
	b%name = block_name
	allocate (b%entry (1))
	end associate

	contains

	subroutine grow
	type(slha_block_t), dimension(:), allocatable :: b_tmp
	call move_alloc (model%slha_block, b_tmp)
	allocate (model%slha_block (2 * size (b_tmp)))
	model%slha_block(:size (b_tmp)) = b_tmp(:)
	end subroutine grow

	end subroutine model_add_slha_block

	@ %def model_add_slha_block
	@ Add a new entry to a block-register record. The entry establishes a
	pointer-target relation between an index array within the SLHA block and a
	parameter-data record. We increase the entry array as needed.
	<<Models: procedures>>=
	subroutine add_slha_block_entry (b, block_index, i_par)
	type(slha_block_t), intent(inout) :: b
	integer, dimension(:), intent(in) :: block_index
	integer, intent(in) :: i_par

	if (b%n_entry == size (b%entry)) call grow
	b%n_entry = b%n_entry + 1
	associate (entry => b%entry(b%n_entry))
	entry%block_index = block_index
	entry%i_par = i_par
	end associate

	contains

	subroutine grow
	type(slha_entry_t), dimension(:), allocatable :: entry_tmp
	call move_alloc (b%entry, entry_tmp)
	allocate (b%entry (2 * size (entry_tmp)))
	b%entry(:size (entry_tmp)) = entry_tmp(:)
	end subroutine grow

	end subroutine add_slha_block_entry

	@ %def add_slha_block_entry
	@
	The lookup routine returns a pointer to the appropriate [[par_data]]
	record, if [[block_name]] and [[block_index]] are valid. The latter
	point to the [[slha_block_t]] register within the [[model_t]] object,
	if it is allocated.

	This should only be needed during I/O (i.e., while reading the SLHA
	file), so a simple linear search for each parameter should not be a
	performance problem.
	<<Models: model: TBP>>=
	procedure :: slha_lookup => model_slha_lookup
	<<Models: sub interfaces>>=
	module subroutine model_slha_lookup &
	(model, block_name, block_index, par_data)
	class(model_t), intent(in) :: model
	type(string_t), intent(in) :: block_name
	integer, dimension(:), intent(in) :: block_index
	class(modelpar_data_t), pointer, intent(out) :: par_data
	end subroutine model_slha_lookup
	<<Models: procedures>>=
	module subroutine model_slha_lookup &
	(model, block_name, block_index, par_data)
	class(model_t), intent(in) :: model
	type(string_t), intent(in) :: block_name
	integer, dimension(:), intent(in) :: block_index
	class(modelpar_data_t), pointer, intent(out) :: par_data

	integer :: i, j

	par_data => null ()
	if (allocated (model%slha_block)) then
	do i = 1, model%n_slha_block
	associate (block => model%slha_block(i))
	if (block%name == block_name) then
	do j = 1, block%n_entry
	associate (entry => block%entry(j))
	if (size (entry%block_index) == size (block_index)) then
	if (all (entry%block_index == block_index)) then
	par_data => model%par(entry%i_par)%data
	return
	end if
	end if
	end associate
	end do
	end if
	end associate
	end do
	end if

	end subroutine model_slha_lookup

	@ %def model_slha_lookup
	@ Modify the value of a parameter, identified by block name and index array.
	<<Models: model: TBP>>=
	procedure :: slha_set_par => model_slha_set_par
	<<Models: sub interfaces>>=
	module subroutine model_slha_set_par (model, block_name, block_index, value)
	class(model_t), intent(inout) :: model
	type(string_t), intent(in) :: block_name
	integer, dimension(:), intent(in) :: block_index
	real(default), intent(in) :: value
	end subroutine model_slha_set_par
	<<Models: procedures>>=
	module subroutine model_slha_set_par (model, block_name, block_index, value)
	class(model_t), intent(inout) :: model
	type(string_t), intent(in) :: block_name
	integer, dimension(:), intent(in) :: block_index
	real(default), intent(in) :: value

	class(modelpar_data_t), pointer :: par_data

	call model%slha_lookup (block_name, block_index, par_data)
	if (associated (par_data)) then
	par_data = value
	end if

	end subroutine model_slha_set_par

	@ %def model_slha_set_par
	@
	\subsection{Reading models from file}
	This procedure defines the model-file syntax for the parser, returning
	an internal file (ifile).

	Note that arithmetic operators are defined as keywords in the
	expression syntax, so we exclude them here.
	<<Models: procedures>>=
	subroutine define_model_file_syntax (ifile)
	type(ifile_t), intent(inout) :: ifile
	call ifile_append (ifile, "SEQ model_def = model_name_def " // &
	"scheme_header parameters external_pars particles vertices")
	call ifile_append (ifile, "SEQ model_name_def = model model_name")
	call ifile_append (ifile, "KEY model")
	call ifile_append (ifile, "QUO model_name = '""'...'""'")
	call ifile_append (ifile, "SEQ scheme_header = scheme_decl?")
	call ifile_append (ifile, "SEQ scheme_decl = schemes '=' scheme_list")
	call ifile_append (ifile, "KEY schemes")
	call ifile_append (ifile, "LIS scheme_list = scheme_name+")
	call ifile_append (ifile, "QUO scheme_name = '""'...'""'")
	call ifile_append (ifile, "SEQ parameters = generic_par_def*")
	call ifile_append (ifile, "ALT generic_par_def = &
	&parameter_def \| derived_def \| unused_def \| scheme_block")
	call ifile_append (ifile, "SEQ parameter_def = parameter par_name " // &
	"'=' any_real_value slha_annotation?")
	call ifile_append (ifile, "ALT any_real_value = " &
	// "neg_real_value \| pos_real_value \| real_value")
	call ifile_append (ifile, "SEQ neg_real_value = '-' real_value")
	call ifile_append (ifile, "SEQ pos_real_value = '+' real_value")
	call ifile_append (ifile, "KEY parameter")
	call ifile_append (ifile, "IDE par_name")
	! call ifile_append (ifile, "KEY '='") !!! Key already exists
	call ifile_append (ifile, "SEQ slha_annotation = " // &
	"slha_entry slha_block_name slha_entry_index*")
	call ifile_append (ifile, "KEY slha_entry")
	call ifile_append (ifile, "IDE slha_block_name")
	call ifile_append (ifile, "INT slha_entry_index")
	call ifile_append (ifile, "SEQ derived_def = derived par_name " // &
	"'=' expr")
	call ifile_append (ifile, "KEY derived")
	call ifile_append (ifile, "SEQ unused_def = unused par_name")
	call ifile_append (ifile, "KEY unused")
	call ifile_append (ifile, "SEQ external_pars = external_def*")
	call ifile_append (ifile, "SEQ external_def = external par_name")
	call ifile_append (ifile, "KEY external")
	call ifile_append (ifile, "SEQ scheme_block = &
	&scheme_block_beg scheme_block_body scheme_block_end")
	call ifile_append (ifile, "SEQ scheme_block_beg = select scheme")
	call ifile_append (ifile, "SEQ scheme_block_body = scheme_block_case*")
	call ifile_append (ifile, "SEQ scheme_block_case = &
	&scheme scheme_id parameters")
	call ifile_append (ifile, "ALT scheme_id = scheme_list \| other")
	call ifile_append (ifile, "SEQ scheme_block_end = end select")
	call ifile_append (ifile, "KEY select")
	call ifile_append (ifile, "KEY scheme")
	call ifile_append (ifile, "KEY other")
	call ifile_append (ifile, "KEY end")
	call ifile_append (ifile, "SEQ particles = particle_def*")
	call ifile_append (ifile, "SEQ particle_def = particle name_def " // &
	"prt_pdg prt_details")
	call ifile_append (ifile, "KEY particle")
	call ifile_append (ifile, "SEQ prt_pdg = signed_int")
	call ifile_append (ifile, "ALT prt_details = prt_src \| prt_properties")
	call ifile_append (ifile, "SEQ prt_src = like name_def prt_properties")
	call ifile_append (ifile, "KEY like")
	call ifile_append (ifile, "SEQ prt_properties = prt_property*")
	call ifile_append (ifile, "ALT prt_property = " // &
	"parton \| invisible \| gauge \| left \| right \| " // &
	"prt_name \| prt_anti \| prt_tex_name \| prt_tex_anti \| " // &
	"prt_spin \| prt_isospin \| prt_charge \| " // &
	"prt_color \| prt_mass \| prt_width")
	call ifile_append (ifile, "KEY parton")
	call ifile_append (ifile, "KEY invisible")
	call ifile_append (ifile, "KEY gauge")
	call ifile_append (ifile, "KEY left")
	call ifile_append (ifile, "KEY right")
	call ifile_append (ifile, "SEQ prt_name = name name_def+")
	call ifile_append (ifile, "SEQ prt_anti = anti name_def+")
	call ifile_append (ifile, "SEQ prt_tex_name = tex_name name_def")
	call ifile_append (ifile, "SEQ prt_tex_anti = tex_anti name_def")
	call ifile_append (ifile, "KEY name")
	call ifile_append (ifile, "KEY anti")
	call ifile_append (ifile, "KEY tex_name")
	call ifile_append (ifile, "KEY tex_anti")
	call ifile_append (ifile, "ALT name_def = name_string \| name_id")
	call ifile_append (ifile, "QUO name_string = '""'...'""'")
	call ifile_append (ifile, "IDE name_id")
	call ifile_append (ifile, "SEQ prt_spin = spin frac")
	call ifile_append (ifile, "KEY spin")
	call ifile_append (ifile, "SEQ prt_isospin = isospin frac")
	call ifile_append (ifile, "KEY isospin")
	call ifile_append (ifile, "SEQ prt_charge = charge frac")
	call ifile_append (ifile, "KEY charge")
	call ifile_append (ifile, "SEQ prt_color = color integer_literal")
	call ifile_append (ifile, "KEY color")
	call ifile_append (ifile, "SEQ prt_mass = mass par_name")
	call ifile_append (ifile, "KEY mass")
	call ifile_append (ifile, "SEQ prt_width = width par_name")
	call ifile_append (ifile, "KEY width")
	call ifile_append (ifile, "SEQ vertices = vertex_def*")
	call ifile_append (ifile, "SEQ vertex_def = vertex name_def+")
	call ifile_append (ifile, "KEY vertex")
	call define_expr_syntax (ifile, particles=.false., analysis=.false.)
	end subroutine define_model_file_syntax

	@ %def define_model_file_syntax
	@ The model-file syntax and lexer are fixed, therefore stored as
	module variables:
	<<Models: variables>>=
	type(syntax_t), target, save :: syntax_model_file

	@ %def syntax_model_file
	<<Models: public>>=
	public :: syntax_model_file_init
	<<Models: sub interfaces>>=
	module subroutine syntax_model_file_init ()
	end subroutine syntax_model_file_init
	<<Models: procedures>>=
	module subroutine syntax_model_file_init ()
	type(ifile_t) :: ifile
	call define_model_file_syntax (ifile)
	call syntax_init (syntax_model_file, ifile)
	call ifile_final (ifile)
	end subroutine syntax_model_file_init

	@ %def syntax_model_file_init
	<<Models: procedures>>=
	subroutine lexer_init_model_file (lexer)
	type(lexer_t), intent(out) :: lexer
	call lexer_init (lexer, &
	comment_chars = "#!", &
	quote_chars = '"{', &
	quote_match = '"}', &
	single_chars = ":(),", &
	special_class = [ "+-*/^", "<>= " ] , &
	keyword_list = syntax_get_keyword_list_ptr (syntax_model_file))
	end subroutine lexer_init_model_file

	@ %def lexer_init_model_file
	<<Models: public>>=
	public :: syntax_model_file_final
	<<Models: sub interfaces>>=
	module subroutine syntax_model_file_final ()
	end subroutine syntax_model_file_final
	<<Models: procedures>>=
	module subroutine syntax_model_file_final ()
	call syntax_final (syntax_model_file)
	end subroutine syntax_model_file_final

	@ %def syntax_model_file_final
	<<Models: public>>=
	public :: syntax_model_file_write
	<<Models: sub interfaces>>=
	module subroutine syntax_model_file_write (unit)
	integer, intent(in), optional :: unit
	end subroutine syntax_model_file_write
	<<Models: procedures>>=
	module subroutine syntax_model_file_write (unit)
	integer, intent(in), optional :: unit
	call syntax_write (syntax_model_file, unit)
	end subroutine syntax_model_file_write

	@ %def syntax_model_file_write
	@
	Read a model from file. Handle all syntax and respect the provided scheme.

	The [[ufo]] flag just says that the model object should be tagged as
	being derived from an UFO model. The UFO model path may be requested
	by the caller. If not, we use a standard path search for UFO models.
	There is no difference in the
	contents of the file or the generated model object.
	<<Models: model: TBP>>=
	procedure :: read => model_read
	<<Models: sub interfaces>>=
	module subroutine model_read (model, filename, os_data, exist, &
	scheme, ufo, ufo_path_requested, rebuild_mdl)
	class(model_t), intent(out), target :: model
	type(string_t), intent(in) :: filename
	type(os_data_t), intent(in) :: os_data
	logical, intent(out), optional :: exist
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path_requested
	logical, intent(in), optional :: rebuild_mdl
	end subroutine model_read
	<<Models: procedures>>=
	module subroutine model_read (model, filename, os_data, exist, &
	scheme, ufo, ufo_path_requested, rebuild_mdl)
	class(model_t), intent(out), target :: model
	type(string_t), intent(in) :: filename
	type(os_data_t), intent(in) :: os_data
	logical, intent(out), optional :: exist
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path_requested
	logical, intent(in), optional :: rebuild_mdl
	type(string_t) :: file
	type(stream_t), target :: stream
	type(lexer_t) :: lexer
	integer :: unit
	character(32) :: model_md5sum
	type(parse_node_t), pointer :: nd_model_def, nd_model_name_def
	type(parse_node_t), pointer :: nd_schemes, nd_scheme_decl
	type(parse_node_t), pointer :: nd_parameters
	type(parse_node_t), pointer :: nd_external_pars
	type(parse_node_t), pointer :: nd_particles, nd_vertices
	type(string_t) :: model_name, lib_name
	integer :: n_parblock, n_par, i_par, n_ext, n_prt, n_vtx
	type(parse_node_t), pointer :: nd_par_def
	type(parse_node_t), pointer :: nd_ext_def
	type(parse_node_t), pointer :: nd_prt
	type(parse_node_t), pointer :: nd_vtx
	logical :: ufo_model, model_exist, rebuild
	ufo_model = .false.; if (present (ufo)) ufo_model = ufo
	rebuild = .true.; if (present (rebuild_mdl)) rebuild = rebuild_mdl
	file = filename
	inquire (file=char(file), exist=model_exist)
	if ((.not. model_exist) .and. (.not. os_data%use_testfiles)) then
	file = os_data%whizard_modelpath_local // "/" // filename
	inquire (file = char (file), exist = model_exist)
	end if
	if (.not. model_exist) then
	file = os_data%whizard_modelpath // "/" // filename
	inquire (file = char (file), exist = model_exist)
	end if
	if (ufo_model .and. rebuild) then
	file = filename
	call model_generate_ufo (filename, os_data, model%ufo_path, &
	ufo_path_requested=ufo_path_requested)
	inquire (file = char (file), exist = model_exist)
	end if
	if (.not. model_exist) then
	call msg_fatal ("Model file '" // char (filename) // "' not found")
	if (present (exist)) exist = .false.
	return
	end if
	if (present (exist)) exist = .true.

	if (logging) call msg_message ("Reading model file '" // char (file) // "'")

	unit = free_unit ()
	open (file=char(file), unit=unit, action="read", status="old")
	model_md5sum = md5sum (unit)
	close (unit)

	call lexer_init_model_file (lexer)
	call stream_init (stream, char (file))
	call lexer_assign_stream (lexer, stream)
	call parse_tree_init (model%parse_tree, syntax_model_file, lexer)
	call stream_final (stream)
	call lexer_final (lexer)

	nd_model_def => model%parse_tree%get_root_ptr ()
	nd_model_name_def => parse_node_get_sub_ptr (nd_model_def)
	model_name = parse_node_get_string &
	(parse_node_get_sub_ptr (nd_model_name_def, 2))
	nd_schemes => nd_model_name_def%get_next_ptr ()

	call find_block &
	("scheme_header", nd_schemes, nd_scheme_decl, nd_next=nd_parameters)
	call find_block &
	("parameters", nd_parameters, nd_par_def, n_parblock, nd_external_pars)
	call find_block &
	("external_pars", nd_external_pars, nd_ext_def, n_ext, nd_particles)
	call find_block &
	("particles", nd_particles, nd_prt, n_prt, nd_vertices)
	call find_block &
	("vertices", nd_vertices, nd_vtx, n_vtx)

	if (associated (nd_external_pars)) then
	lib_name = "external." // model_name
	else
	lib_name = ""
	end if

	if (associated (nd_scheme_decl)) then
	call handle_schemes (nd_scheme_decl, scheme)
	end if

	n_par = 0
	call count_parameters (nd_par_def, n_parblock, n_par)

	call model%init &
	(model_name, lib_name, os_data, n_par + n_ext, n_prt, n_vtx, ufo)
	model%md5sum = model_md5sum

	if (associated (nd_par_def)) then
	i_par = 0
	call handle_parameters (nd_par_def, n_parblock, i_par)
	end if
	if (associated (nd_ext_def)) then
	call handle_external (nd_ext_def, n_par, n_ext)
	end if
	call model%update_parameters ()
	if (associated (nd_prt)) then
	call handle_fields (nd_prt, n_prt)
	end if
	if (associated (nd_vtx)) then
	call handle_vertices (nd_vtx, n_vtx)
	end if

	call model%freeze_vertices ()
	call model%append_field_vars ()

	contains

	subroutine find_block (key, nd, nd_item, n_item, nd_next)
	character(*), intent(in) :: key
	type(parse_node_t), pointer, intent(inout) :: nd
	type(parse_node_t), pointer, intent(out) :: nd_item
	integer, intent(out), optional :: n_item
	type(parse_node_t), pointer, intent(out), optional :: nd_next
	if (associated (nd)) then
	if (nd%get_rule_key () == key) then
	nd_item => nd%get_sub_ptr ()
	if (present (n_item)) n_item = nd%get_n_sub ()
	if (present (nd_next)) nd_next => nd%get_next_ptr ()
	else
	nd_item => null ()
	if (present (n_item)) n_item = 0
	if (present (nd_next)) nd_next => nd
	nd => null ()
	end if
	else
	nd_item => null ()
	if (present (n_item)) n_item = 0
	if (present (nd_next)) nd_next => null ()
	end if
	end subroutine find_block

	subroutine handle_schemes (nd_scheme_decl, scheme)
	type(parse_node_t), pointer, intent(in) :: nd_scheme_decl
	type(string_t), intent(in), optional :: scheme
	type(parse_node_t), pointer :: nd_list, nd_entry
	type(string_t), dimension(:), allocatable :: schemes
	integer :: i, n_schemes
	nd_list => nd_scheme_decl%get_sub_ptr (3)
	nd_entry => nd_list%get_sub_ptr ()
	n_schemes = nd_list%get_n_sub ()
	allocate (schemes (n_schemes))
	do i = 1, n_schemes
	schemes(i) = nd_entry%get_string ()
	nd_entry => nd_entry%get_next_ptr ()
	end do
	if (present (scheme)) then
	do i = 1, n_schemes
	if (schemes(i) == scheme) goto 10 ! block exit
	end do
	call msg_fatal ("Scheme '" // char (scheme) &
	// "' is not supported by model '" // char (model_name) // "'")
	end if
	10 continue
	call model%enable_schemes (schemes)
	call model%set_scheme (scheme)
	end subroutine handle_schemes

	subroutine select_scheme (nd_scheme_block, n_parblock_sub, nd_par_def)
	type(parse_node_t), pointer, intent(in) :: nd_scheme_block
	integer, intent(out) :: n_parblock_sub
	type(parse_node_t), pointer, intent(out) :: nd_par_def
	type(parse_node_t), pointer :: nd_scheme_body
	type(parse_node_t), pointer :: nd_scheme_case, nd_scheme_id, nd_scheme
	type(string_t) :: scheme
	integer :: n_cases, i
	scheme = model%get_scheme ()
	nd_scheme_body => nd_scheme_block%get_sub_ptr (2)
	nd_parameters => null ()
	select case (char (nd_scheme_body%get_rule_key ()))
	case ("scheme_block_body")
	n_cases = nd_scheme_body%get_n_sub ()
	FIND_SCHEME: do i = 1, n_cases
	nd_scheme_case => nd_scheme_body%get_sub_ptr (i)
	nd_scheme_id => nd_scheme_case%get_sub_ptr (2)
	select case (char (nd_scheme_id%get_rule_key ()))
	case ("scheme_list")
	nd_scheme => nd_scheme_id%get_sub_ptr ()
	do while (associated (nd_scheme))
	if (scheme == nd_scheme%get_string ()) then
	nd_parameters => nd_scheme_id%get_next_ptr ()
	exit FIND_SCHEME
	end if
	nd_scheme => nd_scheme%get_next_ptr ()
	end do
	case ("other")
	nd_parameters => nd_scheme_id%get_next_ptr ()
	exit FIND_SCHEME
	case default
	print *, "'", char (nd_scheme_id%get_rule_key ()), "'"
	call msg_bug ("Model read: impossible scheme rule")
	end select
	end do FIND_SCHEME
	end select
	if (associated (nd_parameters)) then
	select case (char (nd_parameters%get_rule_key ()))
	case ("parameters")
	n_parblock_sub = nd_parameters%get_n_sub ()
	if (n_parblock_sub > 0) then
	nd_par_def => nd_parameters%get_sub_ptr ()
	else
	nd_par_def => null ()
	end if
	case default
	n_parblock_sub = 0
	nd_par_def => null ()
	end select
	else
	n_parblock_sub = 0
	nd_par_def => null ()
	end if
	end subroutine select_scheme

	recursive subroutine count_parameters (nd_par_def_in, n_parblock, n_par)
	type(parse_node_t), pointer, intent(in) :: nd_par_def_in
	integer, intent(in) :: n_parblock
	integer, intent(inout) :: n_par
	type(parse_node_t), pointer :: nd_par_def, nd_par_key
	type(parse_node_t), pointer :: nd_par_def_sub
	integer :: n_parblock_sub
	integer :: i
	nd_par_def => nd_par_def_in
	do i = 1, n_parblock
	nd_par_key => nd_par_def%get_sub_ptr ()
	select case (char (nd_par_key%get_rule_key ()))
	case ("parameter", "derived", "unused")
	n_par = n_par + 1
	case ("scheme_block_beg")
	call select_scheme (nd_par_def, n_parblock_sub, nd_par_def_sub)
	if (n_parblock_sub > 0) then
	call count_parameters (nd_par_def_sub, n_parblock_sub, n_par)
	end if
	case default
	print *, "'", char (nd_par_key%get_rule_key ()), "'"
	call msg_bug ("Model read: impossible parameter rule")
	end select
	nd_par_def => parse_node_get_next_ptr (nd_par_def)
	end do
	end subroutine count_parameters

	recursive subroutine handle_parameters (nd_par_def_in, n_parblock, i_par)
	type(parse_node_t), pointer, intent(in) :: nd_par_def_in
	integer, intent(in) :: n_parblock
	integer, intent(inout) :: i_par
	type(parse_node_t), pointer :: nd_par_def, nd_par_key
	type(parse_node_t), pointer :: nd_par_def_sub
	integer :: n_parblock_sub
	integer :: i
	nd_par_def => nd_par_def_in
	do i = 1, n_parblock
	nd_par_key => nd_par_def%get_sub_ptr ()
	select case (char (nd_par_key%get_rule_key ()))
	case ("parameter")
	i_par = i_par + 1
	call model%read_parameter (i_par, nd_par_def)
	case ("derived")
	i_par = i_par + 1
	call model%read_derived (i_par, nd_par_def)
	case ("unused")
	i_par = i_par + 1
	call model%read_unused (i_par, nd_par_def)
	case ("scheme_block_beg")
	call select_scheme (nd_par_def, n_parblock_sub, nd_par_def_sub)
	if (n_parblock_sub > 0) then
	call handle_parameters (nd_par_def_sub, n_parblock_sub, i_par)
	end if
	end select
	nd_par_def => parse_node_get_next_ptr (nd_par_def)
	end do
	end subroutine handle_parameters

	subroutine handle_external (nd_ext_def, n_par, n_ext)
	type(parse_node_t), pointer, intent(inout) :: nd_ext_def
	integer, intent(in) :: n_par, n_ext
	integer :: i
	do i = n_par + 1, n_par + n_ext
	call model%read_external (i, nd_ext_def)
	nd_ext_def => parse_node_get_next_ptr (nd_ext_def)
	end do
	! real(c_default_float), dimension(:), allocatable :: par
	! if (associated (model%init_external_parameters)) then
	! allocate (par (model%get_n_real ()))
	! call model%real_parameters_to_c_array (par)
	! call model%init_external_parameters (par)
	! call model%real_parameters_from_c_array (par)
	! end if
	end subroutine handle_external

	subroutine handle_fields (nd_prt, n_prt)
	type(parse_node_t), pointer, intent(inout) :: nd_prt
	integer, intent(in) :: n_prt
	integer :: i
	do i = 1, n_prt
	call model%read_field (i, nd_prt)
	nd_prt => parse_node_get_next_ptr (nd_prt)
	end do
	end subroutine handle_fields

	subroutine handle_vertices (nd_vtx, n_vtx)
	type(parse_node_t), pointer, intent(inout) :: nd_vtx
	integer, intent(in) :: n_vtx
	integer :: i
	do i = 1, n_vtx
	call model%read_vertex (i, nd_vtx)
	nd_vtx => parse_node_get_next_ptr (nd_vtx)
	end do
	end subroutine handle_vertices

	end subroutine model_read

	@ %def model_read
	@ Parameters are real values (literal) with an optional unit.
	<<Models: model: TBP>>=
	procedure, private :: read_parameter => model_read_parameter
	<<Models: sub interfaces>>=
	module subroutine model_read_parameter (model, i, node)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in), target :: node
	end subroutine model_read_parameter
	<<Models: procedures>>=
	module subroutine model_read_parameter (model, i, node)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in), target :: node
	type(parse_node_t), pointer :: node_name, node_val, node_slha_entry
	type(string_t) :: name
	node_name => parse_node_get_sub_ptr (node, 2)
	name = parse_node_get_string (node_name)
	node_val => parse_node_get_next_ptr (node_name, 2)
	call model%set_parameter_parse_node (i, name, node_val, constant=.true.)
	node_slha_entry => parse_node_get_next_ptr (node_val)
	if (associated (node_slha_entry)) then
	call model_record_slha_block_entry (model, i, node_slha_entry)
	end if
	end subroutine model_read_parameter

	@ %def model_read_parameter
	@ Derived parameters have any numeric expression as their definition.
	Don't evaluate the expression, yet.
	<<Models: model: TBP>>=
	procedure, private :: read_derived => model_read_derived
	<<Models: sub interfaces>>=
	module subroutine model_read_derived (model, i, node)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in), target :: node
	end subroutine model_read_derived
	<<Models: procedures>>=
	module subroutine model_read_derived (model, i, node)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in), target :: node
	type(string_t) :: name
	type(parse_node_t), pointer :: pn_expr
	name = parse_node_get_string (parse_node_get_sub_ptr (node, 2))
	pn_expr => parse_node_get_sub_ptr (node, 4)
	call model%set_parameter_parse_node (i, name, pn_expr, constant=.false.)
	end subroutine model_read_derived

	@ %def model_read_derived
	@ External parameters have no definition; they are handled by an
	external library.
	<<Models: model: TBP>>=
	procedure, private :: read_external => model_read_external
	<<Models: sub interfaces>>=
	module subroutine model_read_external (model, i, node)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in), target :: node
	end subroutine model_read_external
	<<Models: procedures>>=
	module subroutine model_read_external (model, i, node)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in), target :: node
	type(string_t) :: name
	name = parse_node_get_string (parse_node_get_sub_ptr (node, 2))
	call model%set_parameter_external (i, name)
	end subroutine model_read_external

	@ %def model_read_external
	@ Ditto for unused parameters, they are there just for reserving the name.
	<<Models: model: TBP>>=
	procedure, private :: read_unused => model_read_unused
	<<Models: sub interfaces>>=
	module subroutine model_read_unused (model, i, node)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in), target :: node
	end subroutine model_read_unused
	<<Models: procedures>>=
	module subroutine model_read_unused (model, i, node)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in), target :: node
	type(string_t) :: name
	name = parse_node_get_string (parse_node_get_sub_ptr (node, 2))
	call model%set_parameter_unused (i, name)
	end subroutine model_read_unused

	@ %def model_read_unused
	<<Models: model: TBP>>=
	procedure, private :: read_field => model_read_field
	<<Models: sub interfaces>>=
	module subroutine model_read_field (model, i, node)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in) :: node
	end subroutine model_read_field
	<<Models: procedures>>=
	module subroutine model_read_field (model, i, node)
	class(model_t), intent(inout), target :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in) :: node
	type(parse_node_t), pointer :: nd_src, nd_props, nd_prop
	type(string_t) :: longname
	integer :: pdg
	type(string_t) :: name_src
	type(string_t), dimension(:), allocatable :: name
	type(field_data_t), pointer :: field, field_src
	longname = parse_node_get_string (parse_node_get_sub_ptr (node, 2))
	pdg = read_frac (parse_node_get_sub_ptr (node, 3))
	field => model%get_field_ptr_by_index (i)
	call field%init (longname, pdg)
	nd_src => parse_node_get_sub_ptr (node, 4)
	if (associated (nd_src)) then
	if (parse_node_get_rule_key (nd_src) == "prt_src") then
	name_src = parse_node_get_string (parse_node_get_sub_ptr (nd_src, 2))
	field_src => model%get_field_ptr (name_src, check=.true.)
	call field%copy_from (field_src)
	nd_props => parse_node_get_sub_ptr (nd_src, 3)
	else
	nd_props => nd_src
	end if
	nd_prop => parse_node_get_sub_ptr (nd_props)
	do while (associated (nd_prop))
	select case (char (parse_node_get_rule_key (nd_prop)))
	case ("invisible")
	call field%set (is_visible=.false.)
	case ("parton")
	call field%set (is_parton=.true.)
	case ("gauge")
	call field%set (is_gauge=.true.)
	case ("left")
	call field%set (is_left_handed=.true.)
	case ("right")
	call field%set (is_right_handed=.true.)
	case ("prt_name")
	call read_names (nd_prop, name)
	call field%set (name=name)
	case ("prt_anti")
	call read_names (nd_prop, name)
	call field%set (anti=name)
	case ("prt_tex_name")
	call field%set ( &
	tex_name = parse_node_get_string &
	(parse_node_get_sub_ptr (nd_prop, 2)))
	case ("prt_tex_anti")
	call field%set ( &
	tex_anti = parse_node_get_string &
	(parse_node_get_sub_ptr (nd_prop, 2)))
	case ("prt_spin")
	call field%set ( &
	spin_type = read_frac &
	(parse_node_get_sub_ptr (nd_prop, 2), 2))
	case ("prt_isospin")
	call field%set ( &
	isospin_type = read_frac &
	(parse_node_get_sub_ptr (nd_prop, 2), 2))
	case ("prt_charge")
	call field%set ( &
	charge_type = read_frac &
	(parse_node_get_sub_ptr (nd_prop, 2), 3))
	case ("prt_color")
	call field%set ( &
	color_type = parse_node_get_integer &
	(parse_node_get_sub_ptr (nd_prop, 2)))
	case ("prt_mass")
	call field%set ( &
	mass_data = model%get_par_data_ptr &
	(parse_node_get_string &
	(parse_node_get_sub_ptr (nd_prop, 2))))
	case ("prt_width")
	call field%set ( &
	width_data = model%get_par_data_ptr &
	(parse_node_get_string &
	(parse_node_get_sub_ptr (nd_prop, 2))))
	case default
	call msg_bug (" Unknown particle property '" &
	// char (parse_node_get_rule_key (nd_prop)) // "'")
	end select
	if (allocated (name)) deallocate (name)
	nd_prop => parse_node_get_next_ptr (nd_prop)
	end do
	end if
	call field%freeze ()
	end subroutine model_read_field

	@ %def model_read_field
	<<Models: model: TBP>>=
	procedure, private :: read_vertex => model_read_vertex
	<<Models: sub interfaces>>=
	module subroutine model_read_vertex (model, i, node)
	class(model_t), intent(inout) :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in) :: node
	end subroutine model_read_vertex
	<<Models: procedures>>=
	module subroutine model_read_vertex (model, i, node)
	class(model_t), intent(inout) :: model
	integer, intent(in) :: i
	type(parse_node_t), intent(in) :: node
	type(string_t), dimension(:), allocatable :: name
	call read_names (node, name)
	call model%set_vertex (i, name)
	end subroutine model_read_vertex

	@ %def model_read_vertex
	<<Models: procedures>>=
	subroutine read_names (node, name)
	type(parse_node_t), intent(in) :: node
	type(string_t), dimension(:), allocatable, intent(inout) :: name
	type(parse_node_t), pointer :: nd_name
	integer :: n_names, i
	n_names = parse_node_get_n_sub (node) - 1
	allocate (name (n_names))
	nd_name => parse_node_get_sub_ptr (node, 2)
	do i = 1, n_names
	name(i) = parse_node_get_string (nd_name)
	nd_name => parse_node_get_next_ptr (nd_name)
	end do
	end subroutine read_names

	@ %def read_names
	@ There is an optional argument for the base.
	<<Models: procedures>>=
	function read_frac (nd_frac, base) result (qn_type)
	integer :: qn_type
	type(parse_node_t), intent(in) :: nd_frac
	integer, intent(in), optional :: base
	type(parse_node_t), pointer :: nd_num, nd_den
	integer :: num, den
	nd_num => parse_node_get_sub_ptr (nd_frac)
	nd_den => parse_node_get_next_ptr (nd_num)
	select case (char (parse_node_get_rule_key (nd_num)))
	case ("integer_literal")
	num = parse_node_get_integer (nd_num)
	case ("neg_int")
	num = - parse_node_get_integer (parse_node_get_sub_ptr (nd_num, 2))
	case ("pos_int")
	num = parse_node_get_integer (parse_node_get_sub_ptr (nd_num, 2))
	case default
	call parse_tree_bug (nd_num, "int\|neg_int\|pos_int")
	end select
	if (associated (nd_den)) then
	den = parse_node_get_integer (parse_node_get_sub_ptr (nd_den, 2))
	else
	den = 1
	end if
	if (present (base)) then
	if (den == 1) then
	qn_type = sign (1 + abs (num) * base, num)
	else if (den == base) then
	qn_type = sign (abs (num) + 1, num)
	else
	call parse_node_write_rec (nd_frac)
	call msg_fatal (" Fractional quantum number: wrong denominator")
	end if
	else
	if (den == 1) then
	qn_type = num
	else
	call parse_node_write_rec (nd_frac)
	call msg_fatal (" Wrong type: no fraction expected")
	end if
	end if
	end function read_frac

	@ %def read_frac
	@ Append field (PDG-array) variables to the variable list, based on
	the field content.
	<<Models: model: TBP>>=
	procedure, private :: append_field_vars => model_append_field_vars
	<<Models: sub interfaces>>=
	module subroutine model_append_field_vars (model)
	class(model_t), intent(inout) :: model
	end subroutine model_append_field_vars
	<<Models: procedures>>=
	module subroutine model_append_field_vars (model)
	class(model_t), intent(inout) :: model
	type(pdg_array_t) :: aval
	type(field_data_t), dimension(:), pointer :: field_array
	type(field_data_t), pointer :: field
	type(string_t) :: name
	type(string_t), dimension(:), allocatable :: name_array
	integer, dimension(:), allocatable :: pdg
	logical, dimension(:), allocatable :: mask
	integer :: i, j
	field_array => model%get_field_array_ptr ()
	aval = UNDEFINED
	call model%var_list%append_pdg_array (var_str ("particle"), &
	aval, locked = .true., intrinsic=.true.)
	do i = 1, size (field_array)
	aval = field_array(i)%get_pdg ()
	name = field_array(i)%get_longname ()
	call model%var_list%append_pdg_array &
	(name, aval, locked=.true., intrinsic=.true.)
	call field_array(i)%get_name_array (.false., name_array)
	do j = 1, size (name_array)
	call model%var_list%append_pdg_array (name_array(j), &
	aval, locked=.true., intrinsic=.true.)
	end do
	model%max_field_name_length = &
	max (model%max_field_name_length, len (name_array(1)))
	aval = - field_array(i)%get_pdg ()
	call field_array(i)%get_name_array (.true., name_array)
	do j = 1, size (name_array)
	call model%var_list%append_pdg_array (name_array(j), &
	aval, locked=.true., intrinsic=.true.)
	end do
	if (size (name_array) > 0) then
	model%max_field_name_length = &
	max (model%max_field_name_length, len (name_array(1)))
	end if
	end do
	call model%get_all_pdg (pdg)
	allocate (mask (size (pdg)))
	do i = 1, size (pdg)
	field => model%get_field_ptr (pdg(i))
	mask(i) = field%get_charge_type () /= 1
	end do
	aval = pack (pdg, mask)
	call model%var_list%append_pdg_array (var_str ("charged"), &
	aval, locked = .true., intrinsic=.true.)
	do i = 1, size (pdg)
	field => model%get_field_ptr (pdg(i))
	mask(i) = field%get_charge_type () == 1
	end do
	aval = pack (pdg, mask)
	call model%var_list%append_pdg_array (var_str ("neutral"), &
	aval, locked = .true., intrinsic=.true.)
	do i = 1, size (pdg)
	field => model%get_field_ptr (pdg(i))
	mask(i) = field%get_color_type () /= 1
	end do
	aval = pack (pdg, mask)
	call model%var_list%append_pdg_array (var_str ("colored"), &
	aval, locked = .true., intrinsic=.true.)
	end subroutine model_append_field_vars

	@ %def model_append_field_vars
	@
	\subsection{Test models}
	<<Models: public>>=
	public :: create_test_model
	<<Models: sub interfaces>>=
	module subroutine create_test_model (model_name, test_model)
	type(string_t), intent(in) :: model_name
	type(model_t), intent(out), pointer :: test_model
	end subroutine create_test_model
	<<Models: procedures>>=
	module subroutine create_test_model (model_name, test_model)
	type(string_t), intent(in) :: model_name
	type(model_t), intent(out), pointer :: test_model
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	call syntax_model_file_init ()
	call os_data%init ()
	call model_list%read_model &
	(model_name, model_name // var_str (".mdl"), os_data, test_model)
	end subroutine create_test_model

	@ %def create_test_model
	@
	\subsection{Model list}
	List of currently active models
	<<Models: types>>=
	type, extends (model_t) :: model_entry_t
	type(model_entry_t), pointer :: next => null ()
	end type model_entry_t

	@ %def model_entry_t
	<<Models: public>>=
	public :: model_list_t
	<<Models: types>>=
	type :: model_list_t
	type(model_entry_t), pointer :: first => null ()
	type(model_entry_t), pointer :: last => null ()
	type(model_list_t), pointer :: context => null ()
	contains
	<<Models: model list: TBP>>
	end type model_list_t

	@ %def model_list_t
	@ Write an account of the model list. We write linked lists first, starting
	from the global context.
	<<Models: model list: TBP>>=
	procedure :: write => model_list_write
	<<Models: sub interfaces>>=
	recursive module subroutine model_list_write &
	(object, unit, verbose, follow_link)
	class(model_list_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: follow_link
	end subroutine model_list_write
	<<Models: procedures>>=
	recursive module subroutine model_list_write &
	(object, unit, verbose, follow_link)
	class(model_list_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: follow_link
	type(model_entry_t), pointer :: current
	logical :: rec
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	rec = .true.; if (present (follow_link)) rec = follow_link
	if (rec .and. associated (object%context)) then
	call object%context%write (unit, verbose, follow_link)
	end if
	current => object%first
	if (associated (current)) then
	do while (associated (current))
	call current%write (unit, verbose)
	current => current%next
	if (associated (current)) write (u, *)
	end do
	end if
	end subroutine model_list_write

	@ %def model_list_write
	@ Link this list to another one.
	<<Models: model list: TBP>>=
	procedure :: link => model_list_link
	<<Models: sub interfaces>>=
	module subroutine model_list_link (model_list, context)
	class(model_list_t), intent(inout) :: model_list
	type(model_list_t), intent(in), target :: context
	end subroutine model_list_link
	<<Models: procedures>>=
	module subroutine model_list_link (model_list, context)
	class(model_list_t), intent(inout) :: model_list
	type(model_list_t), intent(in), target :: context
	model_list%context => context
	end subroutine model_list_link

	@ %def model_list_link
	@ (Private, used below:)
	Append an existing model, for which we have allocated a pointer entry, to
	the model list. The original pointer becomes disassociated, and the model
	should now be considered as part of the list. We assume that this model is
	not yet part of the list.

	If we provide a [[model]] argument, this returns a pointer to the new entry.
	<<Models: model list: TBP>>=
	procedure, private :: import => model_list_import
	<<Models: sub interfaces>>=
	module subroutine model_list_import (model_list, current, model)
	class(model_list_t), intent(inout) :: model_list
	type(model_entry_t), pointer, intent(inout) :: current
	type(model_t), optional, pointer, intent(out) :: model
	end subroutine model_list_import
	<<Models: procedures>>=
	module subroutine model_list_import (model_list, current, model)
	class(model_list_t), intent(inout) :: model_list
	type(model_entry_t), pointer, intent(inout) :: current
	type(model_t), optional, pointer, intent(out) :: model
	if (associated (current)) then
	if (associated (model_list%first)) then
	model_list%last%next => current
	else
	model_list%first => current
	end if
	model_list%last => current
	if (present (model)) model => current%model_t
	current => null ()
	end if
	end subroutine model_list_import

	@ %def model_list_import
	@ Currently test only:

	Add a new model with given [[name]] to the list, if it does not yet
	exist. If successful, return a pointer to the new model.
	<<Models: model list: TBP>>=
	procedure :: add => model_list_add
	<<Models: sub interfaces>>=
	module subroutine model_list_add (model_list, &
	name, os_data, n_par, n_prt, n_vtx, model)
	class(model_list_t), intent(inout) :: model_list
	type(string_t), intent(in) :: name
	type(os_data_t), intent(in) :: os_data
	integer, intent(in) :: n_par, n_prt, n_vtx
	type(model_t), pointer :: model
	end subroutine model_list_add
	<<Models: procedures>>=
	module subroutine model_list_add (model_list, &
	name, os_data, n_par, n_prt, n_vtx, model)
	class(model_list_t), intent(inout) :: model_list
	type(string_t), intent(in) :: name
	type(os_data_t), intent(in) :: os_data
	integer, intent(in) :: n_par, n_prt, n_vtx
	type(model_t), pointer :: model
	type(model_entry_t), pointer :: current
	if (model_list%model_exists (name, follow_link=.false.)) then
	model => null ()
	else
	allocate (current)
	call current%init (name, var_str (""), os_data, &
	n_par, n_prt, n_vtx)
	call model_list%import (current, model)
	end if
	end subroutine model_list_add

	@ %def model_list_add
	@ Read a new model from file and add to the list, if it does not yet
	exist. Finalize the model by allocating the vertex table. Return a
	pointer to the new model. If unsuccessful, return the original
	pointer.

	The model is always inserted in the last link of a chain of model lists. This
	way, we avoid loading models twice from different contexts. When a model is
	modified, we should first allocate a local copy.
	<<Models: model list: TBP>>=
	procedure :: read_model => model_list_read_model
	<<Models: sub interfaces>>=
	module subroutine model_list_read_model &
	(model_list, name, filename, os_data, model, &
	scheme, ufo, ufo_path, rebuild_mdl)
	class(model_list_t), intent(inout), target :: model_list
	type(string_t), intent(in) :: name, filename
	type(os_data_t), intent(in) :: os_data
	type(model_t), pointer, intent(inout) :: model
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	logical, intent(in), optional :: rebuild_mdl
	end subroutine model_list_read_model
	<<Models: procedures>>=
	module subroutine model_list_read_model &
	(model_list, name, filename, os_data, model, &
	scheme, ufo, ufo_path, rebuild_mdl)
	class(model_list_t), intent(inout), target :: model_list
	type(string_t), intent(in) :: name, filename
	type(os_data_t), intent(in) :: os_data
	type(model_t), pointer, intent(inout) :: model
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	logical, intent(in), optional :: rebuild_mdl
	class(model_list_t), pointer :: global_model_list
	type(model_entry_t), pointer :: current
	logical :: exist
	if (.not. model_list%model_exists (name, &
	scheme, ufo, ufo_path, follow_link=.true.)) then
	allocate (current)
	call current%read (filename, os_data, exist, &
	scheme=scheme, ufo=ufo, ufo_path_requested=ufo_path, &
	rebuild_mdl=rebuild_mdl)
	if (.not. exist) return
	if (current%get_name () /= name) then
	call msg_fatal ("Model file '" // char (filename) // &
	"' contains model '" // char (current%get_name ()) // &
	"' instead of '" // char (name) // "'")
	call current%final (); deallocate (current)
	return
	end if
	global_model_list => model_list
	do while (associated (global_model_list%context))
	global_model_list => global_model_list%context
	end do
	call global_model_list%import (current, model)
	else
	model => model_list%get_model_ptr (name, scheme, ufo, ufo_path)
	end if
	end subroutine model_list_read_model

	@ %def model_list_read_model
	@ Append a copy of an existing model to a model list. Optionally, return
	pointer to the new entry.
	<<Models: model list: TBP>>=
	procedure :: append_copy => model_list_append_copy
	<<Models: sub interfaces>>=
	module subroutine model_list_append_copy (model_list, orig, model)
	class(model_list_t), intent(inout) :: model_list
	type(model_t), intent(in), target :: orig
	type(model_t), intent(out), pointer, optional :: model
	end subroutine model_list_append_copy
	<<Models: procedures>>=
	module subroutine model_list_append_copy (model_list, orig, model)
	class(model_list_t), intent(inout) :: model_list
	type(model_t), intent(in), target :: orig
	type(model_t), intent(out), pointer, optional :: model
	type(model_entry_t), pointer :: copy
	allocate (copy)
	call copy%init_instance (orig)
	call model_list%import (copy, model)
	end subroutine model_list_append_copy

	@ %def model_list_append_copy
	@ Check if a model exists by examining the list. Check recursively unless
	told otherwise.
	<<Models: model list: TBP>>=
	procedure :: model_exists => model_list_model_exists
	<<Models: sub interfaces>>=
	recursive module function model_list_model_exists &
	(model_list, name, scheme, ufo, ufo_path, follow_link) result (exists)
	class(model_list_t), intent(in) :: model_list
	logical :: exists
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	logical, intent(in), optional :: follow_link
	end function model_list_model_exists
	<<Models: procedures>>=
	recursive module function model_list_model_exists &
	(model_list, name, scheme, ufo, ufo_path, follow_link) result (exists)
	class(model_list_t), intent(in) :: model_list
	logical :: exists
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	logical, intent(in), optional :: follow_link
	type(model_entry_t), pointer :: current
	logical :: rec
	rec = .true.; if (present (follow_link)) rec = follow_link
	current => model_list%first
	do while (associated (current))
	if (current%matches (name, scheme, ufo, ufo_path)) then
	exists = .true.
	return
	end if
	current => current%next
	end do
	if (rec .and. associated (model_list%context)) then
	exists = model_list%context%model_exists (name, &
	scheme, ufo, ufo_path, follow_link)
	else
	exists = .false.
	end if
	end function model_list_model_exists

	@ %def model_list_model_exists
	@ Return a pointer to a named model. Search recursively unless told otherwise.
	<<Models: model list: TBP>>=
	procedure :: get_model_ptr => model_list_get_model_ptr
	<<Models: sub interfaces>>=
	recursive module function model_list_get_model_ptr &
	(model_list, name, scheme, ufo, ufo_path, follow_link) result (model)
	class(model_list_t), intent(in) :: model_list
	type(model_t), pointer :: model
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	logical, intent(in), optional :: follow_link
	end function model_list_get_model_ptr
	<<Models: procedures>>=
	recursive module function model_list_get_model_ptr &
	(model_list, name, scheme, ufo, ufo_path, follow_link) result (model)
	class(model_list_t), intent(in) :: model_list
	type(model_t), pointer :: model
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	logical, intent(in), optional :: follow_link
	type(model_entry_t), pointer :: current
	logical :: rec
	rec = .true.; if (present (follow_link)) rec = follow_link
	current => model_list%first
	do while (associated (current))
	if (current%matches (name, scheme, ufo, ufo_path)) then
	model => current%model_t
	return
	end if
	current => current%next
	end do
	if (rec .and. associated (model_list%context)) then
	model => model_list%context%get_model_ptr (name, &
	scheme, ufo, ufo_path, follow_link)
	else
	model => null ()
	end if
	end function model_list_get_model_ptr

	@ %def model_list_get_model_ptr
	@ Delete the list of models. No recursion.
	<<Models: model list: TBP>>=
	procedure :: final => model_list_final
	<<Models: sub interfaces>>=
	module subroutine model_list_final (model_list)
	class(model_list_t), intent(inout) :: model_list
	end subroutine model_list_final
	<<Models: procedures>>=
	module subroutine model_list_final (model_list)
	class(model_list_t), intent(inout) :: model_list
	type(model_entry_t), pointer :: current
	model_list%last => null ()
	do while (associated (model_list%first))
	current => model_list%first
	model_list%first => model_list%first%next
	call current%final ()
	deallocate (current)
	end do
	end subroutine model_list_final

	@ %def model_list_final
	@
	\subsection{Model instances}
	A model instance is a copy of a model object. The parameters are true
	copies. The particle data and the variable list pointers should point to the
	copy, so modifying the parameters has only a local effect. Hence, we build
	them up explicitly. The vertex array is also rebuilt, it contains particle
	pointers. Finally, the vertex hash table can be copied directly since it
	contains no pointers.

	The [[multiplicity]] entry depends on the association of the [[mass_data]]
	entry and therefore has to be set at the end.

	The instance must carry the [[target]] attribute.

	Parameters: the [[copy_parameter]] method essentially copies the parameter
	decorations (parse node, expression etc.). The current parameter values are
	part of the [[model_data_t]] base type and are copied afterwards via its
	[[copy_from]] method.

	Note: the parameter set is initialized for real parameters only.

	In order for the local model to be able to use the correct UFO model
	setup, UFO model information has to be transferred.
	<<Models: model: TBP>>=
	procedure :: init_instance => model_copy
	<<Models: sub interfaces>>=
	module subroutine model_copy (model, orig)
	class(model_t), intent(out), target :: model
	type(model_t), intent(in) :: orig
	end subroutine model_copy
	<<Models: procedures>>=
	module subroutine model_copy (model, orig)
	class(model_t), intent(out), target :: model
	type(model_t), intent(in) :: orig
	integer :: n_par, n_prt, n_vtx
	integer :: i
	n_par = orig%get_n_real ()
	n_prt = orig%get_n_field ()
	n_vtx = orig%get_n_vtx ()
	- call model%basic_init (orig%get_name (), n_par, n_prt, n_vtx)
	+ if (orig%ufo_model) then
	+ call model%basic_init (orig%get_name (), n_par, n_prt, n_vtx, orig%ufo_path)
	+ else
	+ call model%basic_init (orig%get_name (), n_par, n_prt, n_vtx)
	+ end if
	if (allocated (orig%schemes)) then
	model%schemes = orig%schemes
	if (allocated (orig%selected_scheme)) then
	model%selected_scheme = orig%selected_scheme
	call model%set_scheme_num (orig%get_scheme_num ())
	end if
	end if
	if (allocated (orig%slha_block)) then
	model%slha_block = orig%slha_block
	end if
	model%md5sum = orig%md5sum
	model%ufo_model = orig%ufo_model
	model%ufo_path = orig%ufo_path
	if (allocated (orig%par)) then
	do i = 1, n_par
	call model%copy_parameter (i, orig%par(i))
	end do
	end if
	model%init_external_parameters => orig%init_external_parameters
	call model%model_data_t%copy_from (orig)
	model%max_par_name_length = orig%max_par_name_length
	call model%append_field_vars ()
	end subroutine model_copy

	@ %def model_copy
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[models_ut.f90]]>>=
	<<File header>>

	module models_ut
	use unit_tests
	use models_uti

	<<Standard module head>>

	<<Models: public test>>

	contains

	<<Models: test driver>>

	end module models_ut
	@ %def models_ut
	@
	<<[[models_uti.f90]]>>=
	<<File header>>

	module models_uti

	<<Use kinds>>
	<<Use strings>>
	use file_utils, only: delete_file
	use physics_defs, only: SCALAR, SPINOR
	use os_interface
	use model_data
	use variables

	use models

	<<Standard module head>>

	<<Models: test declarations>>

	contains

	<<Models: tests>>

	end module models_uti
	@ %def models_ut
	@ API: driver for the unit tests below.
	<<Models: public test>>=
	public :: models_test
	<<Models: test driver>>=
	subroutine models_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Models: execute tests>>
	end subroutine models_test

	@ %def models_tests
	@
	\subsubsection{Construct a Model}
	Here, we construct a toy model explicitly without referring to a file.
	<<Models: execute tests>>=
	call test (models_1, "models_1", &
	"construct model", &
	u, results)
	<<Models: test declarations>>=
	public :: models_1
	<<Models: tests>>=
	subroutine models_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(string_t) :: model_name
	type(string_t) :: x_longname
	type(string_t), dimension(2) :: parname
	type(string_t), dimension(2) :: x_name
	type(string_t), dimension(1) :: x_anti
	type(string_t) :: x_tex_name, x_tex_anti
	type(string_t) :: y_longname
	type(string_t), dimension(2) :: y_name
	type(string_t) :: y_tex_name
	type(field_data_t), pointer :: field

	write (u, "(A)") "* Test output: models_1"
	write (u, "(A)") "* Purpose: create a model"
	write (u, *)

	model_name = "Test model"
	call model_list%add (model_name, os_data, 2, 2, 3, model)
	parname(1) = "mx"
	parname(2) = "coup"
	call model%set_parameter_constant (1, parname(1), 10._default)
	call model%set_parameter_constant (2, parname(2), 1.3_default)
	x_longname = "X_LEPTON"
	x_name(1) = "X"
	x_name(2) = "x"
	x_anti(1) = "Xbar"
	x_tex_name = "X^+"
	x_tex_anti = "X^-"
	field => model%get_field_ptr_by_index (1)
	call field%init (x_longname, 99)
	call field%set ( &
	.true., .false., .false., .false., .false., &
	name=x_name, anti=x_anti, tex_name=x_tex_name, tex_anti=x_tex_anti, &
	spin_type=SPINOR, isospin_type=-3, charge_type=2, &
	mass_data=model%get_par_data_ptr (parname(1)))
	y_longname = "Y_COLORON"
	y_name(1) = "Y"
	y_name(2) = "yc"
	y_tex_name = "Y^0"
	field => model%get_field_ptr_by_index (2)
	call field%init (y_longname, 97)
	call field%set ( &
	.false., .false., .true., .false., .false., &
	name=y_name, tex_name=y_tex_name, &
	spin_type=SCALAR, isospin_type=2, charge_type=1, color_type=8)
	call model%set_vertex (1, [99, 99, 99])
	call model%set_vertex (2, [99, 99, 99, 99])
	call model%set_vertex (3, [99, 97, 99])
	call model_list%write (u)

	call model_list%final ()

	write (u, *)
	write (u, "(A)") "* Test output end: models_1"

	end subroutine models_1

	@ %def models_1
	@
	\subsubsection{Read a Model}
	Read a predefined model from file.
	<<Models: execute tests>>=
	call test (models_2, "models_2", &
	"read model", &
	u, results)
	<<Models: test declarations>>=
	public :: models_2
	<<Models: tests>>=
	subroutine models_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(var_list_t), pointer :: var_list
	type(model_t), pointer :: model

	write (u, "(A)") "* Test output: models_2"
	write (u, "(A)") "* Purpose: read a model from file"
	write (u, *)

	call syntax_model_file_init ()
	call os_data%init ()

	call model_list%read_model (var_str ("Test"), var_str ("Test.mdl"), &
	os_data, model)
	call model_list%write (u)

	write (u, *)
	write (u, "(A)") "* Variable list"
	write (u, *)

	var_list => model%get_var_list_ptr ()
	call var_list%write (u)

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call model_list%final ()
	call syntax_model_file_final ()

	write (u, *)
	write (u, "(A)") "* Test output end: models_2"

	end subroutine models_2

	@ %def models_2
	@
	\subsubsection{Model Instance}
	Read a predefined model from file and create an instance.
	<<Models: execute tests>>=
	call test (models_3, "models_3", &
	"model instance", &
	u, results)
	<<Models: test declarations>>=
	public :: models_3
	<<Models: tests>>=
	subroutine models_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(var_list_t), pointer :: var_list
	type(model_t), pointer :: instance

	write (u, "(A)") "* Test output: models_3"
	write (u, "(A)") "* Purpose: create a model instance"
	write (u, *)

	call syntax_model_file_init ()
	call os_data%init ()

	call model_list%read_model (var_str ("Test"), var_str ("Test.mdl"), &
	os_data, model)
	allocate (instance)
	call instance%init_instance (model)

	call model%write (u)

	write (u, *)
	write (u, "(A)") "* Variable list"
	write (u, *)

	var_list => instance%get_var_list_ptr ()
	call var_list%write (u)

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call instance%final ()
	deallocate (instance)

	call model_list%final ()
	call syntax_model_file_final ()

	write (u, *)
	write (u, "(A)") "* Test output end: models_3"

	end subroutine models_3

	@ %def models_test
	@
	\subsubsection{Unstable and Polarized Particles}
	Read a predefined model from file and define decays and polarization.
	<<Models: execute tests>>=
	call test (models_4, "models_4", &
	"handle decays and polarization", &
	u, results)
	<<Models: test declarations>>=
	public :: models_4
	<<Models: tests>>=
	subroutine models_4 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(model_t), pointer :: model, model_instance
	character(32) :: md5sum

	write (u, "(A)") "* Test output: models_4"
	write (u, "(A)") "* Purpose: set and unset decays and polarization"
	write (u, *)

	call syntax_model_file_init ()
	call os_data%init ()

	write (u, "(A)") "* Read model from file"

	call model_list%read_model (var_str ("Test"), var_str ("Test.mdl"), &
	os_data, model)

	md5sum = model%get_parameters_md5sum ()
	write (u, *)
	write (u, "(1x,3A)") "MD5 sum (parameters) = '", md5sum, "'"

	write (u, *)
	write (u, "(A)") "* Set particle decays and polarization"
	write (u, *)

	call model%set_unstable (25, [var_str ("dec1"), var_str ("dec2")])
	call model%set_polarized (6)
	call model%set_unstable (-6, [var_str ("fdec")])

	call model%write (u)

	md5sum = model%get_parameters_md5sum ()
	write (u, *)
	write (u, "(1x,3A)") "MD5 sum (parameters) = '", md5sum, "'"

	write (u, *)
	write (u, "(A)") "* Create a model instance"

	allocate (model_instance)
	call model_instance%init_instance (model)

	write (u, *)
	write (u, "(A)") "* Revert particle decays and polarization"
	write (u, *)

	call model%set_stable (25)
	call model%set_unpolarized (6)
	call model%set_stable (-6)

	call model%write (u)

	md5sum = model%get_parameters_md5sum ()
	write (u, *)
	write (u, "(1x,3A)") "MD5 sum (parameters) = '", md5sum, "'"

	write (u, *)
	write (u, "(A)") "* Show the model instance"
	write (u, *)

	call model_instance%write (u)

	md5sum = model_instance%get_parameters_md5sum ()
	write (u, *)
	write (u, "(1x,3A)") "MD5 sum (parameters) = '", md5sum, "'"

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call model_instance%final ()
	deallocate (model_instance)
	call model_list%final ()
	call syntax_model_file_final ()

	write (u, *)
	write (u, "(A)") "* Test output end: models_4"

	end subroutine models_4

	@ %def models_4
	@
	\subsubsection{Model Variables}
	Read a predefined model from file and modify some parameters.

	Note that the MD5 sum is not modified by this.
	<<Models: execute tests>>=
	call test (models_5, "models_5", &
	"handle parameters", &
	u, results)
	<<Models: test declarations>>=
	public :: models_5
	<<Models: tests>>=
	subroutine models_5 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(model_t), pointer :: model, model_instance
	character(32) :: md5sum

	write (u, "(A)") "* Test output: models_5"
	write (u, "(A)") "* Purpose: access and modify model variables"
	write (u, *)

	call syntax_model_file_init ()
	call os_data%init ()

	write (u, "(A)") "* Read model from file"

	call model_list%read_model (var_str ("Test"), var_str ("Test.mdl"), &
	os_data, model)

	write (u, *)

	call model%write (u, &
	show_md5sum = .true., &
	show_variables = .true., &
	show_parameters = .true., &
	show_particles = .false., &
	show_vertices = .false.)

	write (u, *)
	write (u, "(A)") "* Check parameter status"
	write (u, *)

	write (u, "(1x,A,L1)") "xy exists = ", model%var_exists (var_str ("xx"))
	write (u, "(1x,A,L1)") "ff exists = ", model%var_exists (var_str ("ff"))
	write (u, "(1x,A,L1)") "mf exists = ", model%var_exists (var_str ("mf"))
	write (u, "(1x,A,L1)") "ff locked = ", model%var_is_locked (var_str ("ff"))
	write (u, "(1x,A,L1)") "mf locked = ", model%var_is_locked (var_str ("mf"))

	write (u, *)
	write (u, "(1x,A,F6.2)") "ff = ", model%get_rval (var_str ("ff"))
	write (u, "(1x,A,F6.2)") "mf = ", model%get_rval (var_str ("mf"))

	write (u, *)
	write (u, "(A)") "* Modify parameter"
	write (u, *)

	call model%set_real (var_str ("ff"), 1._default)

	call model%write (u, &
	show_md5sum = .true., &
	show_variables = .true., &
	show_parameters = .true., &
	show_particles = .false., &
	show_vertices = .false.)

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call model_list%final ()
	call syntax_model_file_final ()

	write (u, *)
	write (u, "(A)") "* Test output end: models_5"

	end subroutine models_5

	@ %def models_5
	@
	\subsubsection{Read model with disordered parameters}
	Read a model from file where the ordering of independent and derived
	parameters is non-canonical.
	<<Models: execute tests>>=
	call test (models_6, "models_6", &
	"read model parameters", &
	u, results)
	<<Models: test declarations>>=
	public :: models_6
	<<Models: tests>>=
	subroutine models_6 (u)
	integer, intent(in) :: u
	integer :: um
	character(80) :: buffer
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(var_list_t), pointer :: var_list
	type(model_t), pointer :: model

	write (u, "(A)") "* Test output: models_6"
	write (u, "(A)") "* Purpose: read a model from file &
	&with non-canonical parameter ordering"
	write (u, *)

	open (newunit=um, file="Test6.mdl", status="replace", action="readwrite")
	write (um, "(A)") 'model "Test6"'
	write (um, "(A)") ' parameter a = 1.000000000000E+00'
	write (um, "(A)") ' derived b = 2 * a'
	write (um, "(A)") ' parameter c = 3.000000000000E+00'
	write (um, "(A)") ' unused d'

	rewind (um)
	do
	read (um, "(A)", end=1) buffer
	write (u, "(A)") trim (buffer)
	end do
	1 continue
	close (um)

	call syntax_model_file_init ()
	call os_data%init ()

	call model_list%read_model (var_str ("Test6"), var_str ("Test6.mdl"), &
	os_data, model)

	write (u, *)
	write (u, "(A)") "* Variable list"
	write (u, *)

	var_list => model%get_var_list_ptr ()
	call var_list%write (u)

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call model_list%final ()
	call syntax_model_file_final ()

	write (u, *)
	write (u, "(A)") "* Test output end: models_6"

	end subroutine models_6

	@ %def models_6
	@
	\subsubsection{Read model with schemes}
	Read a model from file which supports scheme selection in the
	parameter list.
	<<Models: execute tests>>=
	call test (models_7, "models_7", &
	"handle schemes", &
	u, results)
	<<Models: test declarations>>=
	public :: models_7
	<<Models: tests>>=
	subroutine models_7 (u)
	integer, intent(in) :: u
	integer :: um
	character(80) :: buffer
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(var_list_t), pointer :: var_list
	type(model_t), pointer :: model

	write (u, "(A)") "* Test output: models_7"
	write (u, "(A)") "* Purpose: read a model from file &
	&with scheme selection"
	write (u, *)

	open (newunit=um, file="Test7.mdl", status="replace", action="readwrite")
	write (um, "(A)") 'model "Test7"'
	write (um, "(A)") ' schemes = "foo", "bar", "gee"'
	write (um, "(A)") ''
	write (um, "(A)") ' select scheme'
	write (um, "(A)") ' scheme "foo"'
	write (um, "(A)") ' parameter a = 1'
	write (um, "(A)") ' derived b = 2 * a'
	write (um, "(A)") ' scheme other'
	write (um, "(A)") ' parameter b = 4'
	write (um, "(A)") ' derived a = b / 2'
	write (um, "(A)") ' end select'
	write (um, "(A)") ''
	write (um, "(A)") ' parameter c = 3'
	write (um, "(A)") ''
	write (um, "(A)") ' select scheme'
	write (um, "(A)") ' scheme "foo", "gee"'
	write (um, "(A)") ' derived d = b + c'
	write (um, "(A)") ' scheme other'
	write (um, "(A)") ' unused d'
	write (um, "(A)") ' end select'

	rewind (um)
	do
	read (um, "(A)", end=1) buffer
	write (u, "(A)") trim (buffer)
	end do
	1 continue
	close (um)

	call syntax_model_file_init ()
	call os_data%init ()

	write (u, *)
	write (u, "(A)") "* Model output, default scheme (= foo)"
	write (u, *)

	call model_list%read_model (var_str ("Test7"), var_str ("Test7.mdl"), &
	os_data, model)
	call model%write (u, show_md5sum=.false.)
	call show_var_list ()
	call show_par_array ()

	call model_list%final ()

	write (u, *)
	write (u, "(A)") "* Model output, scheme foo"
	write (u, *)

	call model_list%read_model (var_str ("Test7"), var_str ("Test7.mdl"), &
	os_data, model, scheme = var_str ("foo"))
	call model%write (u, show_md5sum=.false.)
	call show_var_list ()
	call show_par_array ()

	call model_list%final ()

	write (u, *)
	write (u, "(A)") "* Model output, scheme bar"
	write (u, *)

	call model_list%read_model (var_str ("Test7"), var_str ("Test7.mdl"), &
	os_data, model, scheme = var_str ("bar"))
	call model%write (u, show_md5sum=.false.)
	call show_var_list ()
	call show_par_array ()

	call model_list%final ()

	write (u, *)
	write (u, "(A)") "* Model output, scheme gee"
	write (u, *)

	call model_list%read_model (var_str ("Test7"), var_str ("Test7.mdl"), &
	os_data, model, scheme = var_str ("gee"))
	call model%write (u, show_md5sum=.false.)
	call show_var_list ()
	call show_par_array ()

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call model_list%final ()
	call syntax_model_file_final ()

	write (u, *)
	write (u, "(A)") "* Test output end: models_7"

	contains

	subroutine show_var_list ()
	write (u, *)
	write (u, "(A)") "* Variable list"
	write (u, *)
	var_list => model%get_var_list_ptr ()
	call var_list%write (u)
	end subroutine show_var_list

	subroutine show_par_array ()
	real(default), dimension(:), allocatable :: par
	integer :: n
	write (u, *)
	write (u, "(A)") "* Parameter array"
	write (u, *)
	n = model%get_n_real ()
	allocate (par (n))
	call model%real_parameters_to_array (par)
	write (u, 1) par
	1 format (1X,F6.3)
	end subroutine show_par_array

	end subroutine models_7

	@ %def models_7
	@
	\subsubsection{Read and handle UFO model}
	Read a model from file which is considered as an UFO model. In fact,
	it is a mock model file which just follows our naming convention for
	UFO models. Compare this to an equivalent non-UFO model.
	<<Models: execute tests>>=
	call test (models_8, "models_8", &
	"handle UFO-derived models", &
	u, results)
	<<Models: test declarations>>=
	public :: models_8
	<<Models: tests>>=
	subroutine models_8 (u)
	integer, intent(in) :: u
	integer :: um
	character(80) :: buffer
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(string_t) :: model_name
	type(model_t), pointer :: model

	write (u, "(A)") "* Test output: models_8"
	write (u, "(A)") "* Purpose: distinguish models marked as UFO-derived"
	write (u, *)

	call os_data%init ()

	call show_model_list_status ()
	model_name = "models_8_M"

	write (u, *)
	write (u, "(A)") "* Write WHIZARD model"
	write (u, *)

	open (newunit=um, file=char (model_name // ".mdl"), &
	status="replace", action="readwrite")
	write (um, "(A)") 'model "models_8_M"'
	write (um, "(A)") ' parameter a = 1'

	rewind (um)
	do
	read (um, "(A)", end=1) buffer
	write (u, "(A)") trim (buffer)
	end do
	1 continue
	close (um)

	write (u, *)
	write (u, "(A)") "* Write UFO model"
	write (u, *)

	open (newunit=um, file=char (model_name // ".ufo.mdl"), &
	status="replace", action="readwrite")
	write (um, "(A)") 'model "models_8_M"'
	write (um, "(A)") ' parameter a = 2'

	rewind (um)
	do
	read (um, "(A)", end=2) buffer
	write (u, "(A)") trim (buffer)
	end do
	2 continue
	close (um)

	call syntax_model_file_init ()
	call os_data%init ()

	write (u, *)
	write (u, "(A)") "* Read WHIZARD model"
	write (u, *)

	call model_list%read_model (model_name, model_name // ".mdl", &
	os_data, model)
	call model%write (u, show_md5sum=.false.)

	call show_model_list_status ()

	write (u, *)
	write (u, "(A)") "* Read UFO model"
	write (u, *)

	call model_list%read_model (model_name, model_name // ".ufo.mdl", &
	os_data, model, ufo=.true., rebuild_mdl = .false.)
	call model%write (u, show_md5sum=.false.)

	call show_model_list_status ()

	write (u, *)
	write (u, "(A)") "* Reload WHIZARD model"
	write (u, *)

	call model_list%read_model (model_name, model_name // ".mdl", &
	os_data, model)
	call model%write (u, show_md5sum=.false.)

	call show_model_list_status ()

	write (u, *)
	write (u, "(A)") "* Reload UFO model"
	write (u, *)

	call model_list%read_model (model_name, model_name // ".ufo.mdl", &
	os_data, model, ufo=.true., rebuild_mdl = .false.)
	call model%write (u, show_md5sum=.false.)

	call show_model_list_status ()

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call model_list%final ()
	call syntax_model_file_final ()

	write (u, *)
	write (u, "(A)") "* Test output end: models_8"

	contains

	subroutine show_model_list_status ()
	write (u, "(A)") "* Model list status"
	write (u, *)
	write (u, "(A,1x,L1)") "WHIZARD model exists =", &
	model_list%model_exists (model_name)
	write (u, "(A,1x,L1)") "UFO model exists =", &
	model_list%model_exists (model_name, ufo=.true.)
	end subroutine show_model_list_status

	end subroutine models_8

	@ %def models_8
	@
	\subsubsection{Generate UFO model file}
	Generate the necessary [[.ufo.mdl]] file from source, calling OMega, and load the model.

	Note: There must not be another unit test which works with the same
	UFO model. The model file is deleted explicitly at the end of this test.
	<<Models: execute tests>>=
	call test (models_9, "models_9", &
	"generate UFO-derived model file", &
	u, results)
	<<Models: test declarations>>=
	public :: models_9
	<<Models: tests>>=
	subroutine models_9 (u)
	integer, intent(in) :: u
	integer :: um
	character(80) :: buffer
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(string_t) :: model_name, model_file_name
	type(model_t), pointer :: model

	write (u, "(A)") "* Test output: models_9"
	write (u, "(A)") "* Purpose: enable the UFO Standard Model (test version)"
	write (u, *)

	call os_data%init ()
	call syntax_model_file_init ()

	os_data%whizard_modelpath_ufo = "../models/UFO"

	model_name = "SM"
	model_file_name = model_name // ".models_9" // ".ufo.mdl"

	write (u, "(A)") "* Generate and read UFO model"
	write (u, *)

	call delete_file (char (model_file_name))

	call model_list%read_model (model_name, model_file_name, os_data, model, ufo=.true.)
	call model%write (u, show_md5sum=.false.)

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call model_list%final ()
	call syntax_model_file_final ()

	write (u, *)
	write (u, "(A)") "* Test output end: models_9"

	end subroutine models_9

	@ %def models_9
	@
	\subsubsection{Read model with schemes}
	Read a model from file which contains [[slha_entry]] qualifiers for parameters.
	<<Models: execute tests>>=
	call test (models_10, "models_10", &
	"handle slha_entry option", &
	u, results)
	<<Models: test declarations>>=
	public :: models_10
	<<Models: tests>>=
	subroutine models_10 (u)
	integer, intent(in) :: u
	integer :: um
	character(80) :: buffer
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(var_list_t), pointer :: var_list
	type(model_t), pointer :: model
	type(string_t), dimension(:), allocatable :: slha_block_name
	integer :: i

	write (u, "(A)") "* Test output: models_10"
	write (u, "(A)") "* Purpose: read a model from file &
	&with slha_entry options"
	write (u, *)

	open (newunit=um, file="Test10.mdl", status="replace", action="readwrite")
	write (um, "(A)") 'model "Test10"'
	write (um, "(A)") ' parameter a = 1 slha_entry FOO 1'
	write (um, "(A)") ' parameter b = 4 slha_entry BAR 2 1'

	rewind (um)
	do
	read (um, "(A)", end=1) buffer
	write (u, "(A)") trim (buffer)
	end do
	1 continue
	close (um)

	call syntax_model_file_init ()
	call os_data%init ()

	write (u, *)
	write (u, "(A)") "* Model output, default scheme (= foo)"
	write (u, *)

	call model_list%read_model (var_str ("Test10"), var_str ("Test10.mdl"), &
	os_data, model)
	call model%write (u, show_md5sum=.false.)

	write (u, *)
	write (u, "(A)") "* Check that model contains slha_entry options"
	write (u, *)

	write (u, "(A,1x,L1)") &
	"supports_custom_slha =", model%supports_custom_slha ()

	write (u, *)
	write (u, "(A)") "custom_slha_blocks ="
	call model%get_custom_slha_blocks (slha_block_name)
	do i = 1, size (slha_block_name)
	write (u, "(1x,A)", advance="no") char (slha_block_name(i))
	end do
	write (u, *)

	write (u, *)
	write (u, "(A)") "* Parameter lookup"
	write (u, *)

	call show_slha ("FOO", [1])
	call show_slha ("FOO", [2])
	call show_slha ("BAR", [2, 1])
	call show_slha ("GEE", [3])

	write (u, *)
	write (u, "(A)") "* Modify parameter via SLHA block interface"
	write (u, *)

	call model%slha_set_par (var_str ("FOO"), [1], 7._default)
	call show_slha ("FOO", [1])

	write (u, *)
	write (u, "(A)") "* Show var list with modified parameter"
	write (u, *)

	call show_var_list ()

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call model_list%final ()
	call syntax_model_file_final ()

	write (u, *)
	write (u, "(A)") "* Test output end: models_10"

	contains

	subroutine show_slha (block_name, block_index)
	character(*), intent(in) :: block_name
	integer, dimension(:), intent(in) :: block_index
	class(modelpar_data_t), pointer :: par_data
	write (u, "(A,*(1x,I0))", advance="no") block_name, block_index
	write (u, "(' => ')", advance="no")
	call model%slha_lookup (var_str (block_name), block_index, par_data)
	if (associated (par_data)) then
	call par_data%write (u)
	write (u, *)
	else
	write (u, "('-')")
	end if

	end subroutine show_slha

	subroutine show_var_list ()
	var_list => model%get_var_list_ptr ()
	call var_list%write (u)
	end subroutine show_var_list

	end subroutine models_10

	@ %def models_10
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{The SUSY Les Houches Accord}

	The SUSY Les Houches Accord defines a standard interfaces for storing
	the physics data of SUSY models. Here, we provide the means
	for reading, storing, and writing such data.
	<<[[slha_interface.f90]]>>=
	<<File header>>

	module slha_interface

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use lexers
	use parser
	use variables
	use models

	<<Standard module head>>

	<<SLHA: public>>

	<<SLHA: types>>

	interface
	<<SLHA: sub interfaces>>
	end interface

	save

	end module slha_interface
	@ %def slha_interface
	@
	<<[[slha_interface_sub.f90]]>>=
	<<File header>>

	submodule (slha_interface) slha_interface_s

	use io_units
	use constants
	use string_utils, only: upper_case
	use system_defs, only: VERSION_STRING
	use system_defs, only: EOF
	use diagnostics
	use ifiles
	use syntax_rules

	implicit none

	<<SLHA: parameters>>

	<<SLHA: variables>>

	contains

	<<SLHA: procedures>>

	end submodule slha_interface_s

	@ %def slha_interface_s
	@
	\subsection{Preprocessor}
	SLHA is a mixed-format standard. It should be read in assuming free
	format (but line-oriented), but it has some fixed-format elements.

	To overcome this difficulty, we implement a preprocessing step which
	transforms the SLHA into a format that can be swallowed by our generic
	free-format lexer and parser. Each line with a blank first character
	is assumed to be a data line. We prepend a 'DATA' keyword to these lines.
	Furthermore, to enforce line-orientation, each line is appended a '\$'
	key which is recognized by the parser. To do this properly, we first
	remove trailing comments, and skip lines consisting only of comments.

	The preprocessor reads from a stream and puts out an [[ifile]].
	Blocks that are not recognized are skipped. For some blocks, data
	items are quoted, so they can be read as strings if necessary.

	A name clash occurse if the block name is identical to a keyword.
	This can happen for custom SLHA models and files. In that case, we
	prepend an underscore, which will be silently suppressed where needed.
	<<SLHA: parameters>>=
	integer, parameter :: MODE_SKIP = 0, MODE_DATA = 1, MODE_INFO = 2

	@ %def MODE_SKIP = 0, MODE_DATA = 1, MODE_INFO = 2
	<<SLHA: procedures>>=
	subroutine slha_preprocess (stream, custom_block_name, ifile)
	type(stream_t), intent(inout), target :: stream
	type(string_t), dimension(:), intent(in) :: custom_block_name
	type(ifile_t), intent(out) :: ifile
	type(string_t) :: buffer, line, item
	integer :: iostat
	integer :: mode
	mode = MODE
	SCAN_FILE: do
	call stream_get_record (stream, buffer, iostat)
	select case (iostat)
	case (0)
	call split (buffer, line, "#")
	if (len_trim (line) == 0) cycle SCAN_FILE
	select case (char (extract (line, 1, 1)))
	case ("B", "b")
	call check_block_handling (line, custom_block_name, mode)
	call ifile_append (ifile, line // "$")
	case ("D", "d")
	mode = MODE_DATA
	call ifile_append (ifile, line // "$")
	case (" ")
	select case (mode)
	case (MODE_DATA)
	call ifile_append (ifile, "DATA" // line // "$")
	case (MODE_INFO)
	line = adjustl (line)
	call split (line, item, " ")
	call ifile_append (ifile, "INFO" // " " // item // " " &
	// '"' // trim (adjustl (line)) // '" $')
	end select
	case default
	call msg_message (char (line))
	call msg_fatal ("SLHA: Incomprehensible line")
	end select
	case (EOF)
	exit SCAN_FILE
	case default
	call msg_fatal ("SLHA: I/O error occured while reading SLHA input")
	end select
	end do SCAN_FILE
	end subroutine slha_preprocess

	@ %def slha_preprocess
	@ Return the mode that we should treat this block with. We add the
	[[custom_block_name]] array to the set of supported blocks, which
	otherwise includes only hard-coded block names. Those custom blocks
	are data blocks.

	Unknown blocks will be skipped altogether. The standard does not
	specify their internal format at all, so we must not parse their
	content.

	If the name of a (custom) block clashes with a keyword of the SLHA
	syntax, we append an underscore to the block name, modifying the
	current line string. This should be silently suppressed when actually
	parsing block names.
	<<SLHA: procedures>>=
	subroutine check_block_handling (line, custom_block_name, mode)
	type(string_t), intent(inout) :: line
	type(string_t), dimension(:), intent(in) :: custom_block_name
	integer, intent(out) :: mode
	type(string_t) :: buffer, key, block_name
	integer :: i
	buffer = trim (line)
	call split (buffer, key, " ")
	buffer = adjustl (buffer)
	call split (buffer, block_name, " ")
	buffer = adjustl (buffer)
	block_name = trim (adjustl (upper_case (block_name)))
	select case (char (block_name))
	case ("MODSEL", "MINPAR", "SMINPUTS")
	mode = MODE_DATA
	case ("MASS")
	mode = MODE_DATA
	case ("NMIX", "UMIX", "VMIX", "STOPMIX", "SBOTMIX", "STAUMIX")
	mode = MODE_DATA
	case ("NMHMIX", "NMAMIX", "NMNMIX", "NMSSMRUN")
	mode = MODE_DATA
	case ("ALPHA", "HMIX")
	mode = MODE_DATA
	case ("AU", "AD", "AE")
	mode = MODE_DATA
	case ("SPINFO", "DCINFO")
	mode = MODE_INFO
	case default
	mode = MODE_SKIP
	CHECK_CUSTOM_NAMES: do i = 1, size (custom_block_name)
	if (block_name == custom_block_name(i)) then
	mode = MODE_DATA
	call mangle_keywords (block_name)
	line = key // " " // block_name // " " // trim (buffer)
	exit CHECK_CUSTOM_NAMES
	end if
	end do CHECK_CUSTOM_NAMES
	end select
	end subroutine check_block_handling

	@ %def check_block_handling
	@ Append an underscore to specific block names:
	<<SLHA: procedures>>=
	subroutine mangle_keywords (name)
	type(string_t), intent(inout) :: name
	select case (char (name))
	case ("BLOCK", "DATA", "INFO", "DECAY")
	name = name // "_"
	end select
	end subroutine mangle_keywords

	@ %def mangle_keywords
	@ Remove the underscore again:
	<<SLHA: procedures>>=
	subroutine demangle_keywords (name)
	type(string_t), intent(inout) :: name
	select case (char (name))
	case ("BLOCK_", "DATA_", "INFO_", "DECAY_")
	name = extract (name, 1, len(name)-1)
	end select
	end subroutine demangle_keywords

	@ %def demangle_keywords

	@
	\subsection{Lexer and syntax}
	<<SLHA: variables>>=
	type(syntax_t), target :: syntax_slha

	@ %def syntax_slha
	<<SLHA: public>>=
	public :: syntax_slha_init
	<<SLHA: sub interfaces>>=
	module subroutine syntax_slha_init ()
	end subroutine syntax_slha_init
	<<SLHA: procedures>>=
	module subroutine syntax_slha_init ()
	type(ifile_t) :: ifile
	call define_slha_syntax (ifile)
	call syntax_init (syntax_slha, ifile)
	call ifile_final (ifile)
	end subroutine syntax_slha_init

	@ %def syntax_slha_init
	<<SLHA: public>>=
	public :: syntax_slha_final
	<<SLHA: sub interfaces>>=
	module subroutine syntax_slha_final ()
	end subroutine syntax_slha_final
	<<SLHA: procedures>>=
	module subroutine syntax_slha_final ()
	call syntax_final (syntax_slha)
	end subroutine syntax_slha_final

	@ %def syntax_slha_final
	<<SLHA: public>>=
	public :: syntax_slha_write
	<<SLHA: sub interfaces>>=
	module subroutine syntax_slha_write (unit)
	integer, intent(in), optional :: unit
	end subroutine syntax_slha_write
	<<SLHA: procedures>>=
	module subroutine syntax_slha_write (unit)
	integer, intent(in), optional :: unit
	call syntax_write (syntax_slha, unit)
	end subroutine syntax_slha_write

	@ %def syntax_slha_write
	<<SLHA: procedures>>=
	subroutine define_slha_syntax (ifile)
	type(ifile_t), intent(inout) :: ifile
	call ifile_append (ifile, "SEQ slha = chunk*")
	call ifile_append (ifile, "ALT chunk = block_def \| decay_def")
	call ifile_append (ifile, "SEQ block_def = " &
	// "BLOCK blockgen '$' block_line*")
	call ifile_append (ifile, "ALT blockgen = block_spec \| q_spec")
	call ifile_append (ifile, "KEY BLOCK")
	call ifile_append (ifile, "SEQ q_spec = QNUMBERS pdg_code")
	call ifile_append (ifile, "KEY QNUMBERS")
	call ifile_append (ifile, "SEQ block_spec = block_name qvalue?")
	call ifile_append (ifile, "IDE block_name")
	call ifile_append (ifile, "SEQ qvalue = qname '=' qitem")
	call ifile_append (ifile, "IDE qname")
	call ifile_append (ifile, "ALT qitem = signed_real \| real")
	call ifile_append (ifile, "SEQ signed_real = sign real")
	call ifile_append (ifile, "KEY '='")
	call ifile_append (ifile, "REA real")
	call ifile_append (ifile, "KEY '$'")
	call ifile_append (ifile, "ALT block_line = block_data \| block_info")
	call ifile_append (ifile, "SEQ block_data = DATA data_line '$'")
	call ifile_append (ifile, "KEY DATA")
	call ifile_append (ifile, "SEQ data_line = data_item+")
	call ifile_append (ifile, "ALT data_item = signed_number \| number")
	call ifile_append (ifile, "SEQ signed_number = sign number")
	call ifile_append (ifile, "ALT sign = '+' \| '-'")
	call ifile_append (ifile, "ALT number = integer \| real")
	call ifile_append (ifile, "INT integer")
	call ifile_append (ifile, "KEY '-'")
	call ifile_append (ifile, "KEY '+'")
	call ifile_append (ifile, "SEQ block_info = INFO info_line '$'")
	call ifile_append (ifile, "KEY INFO")
	call ifile_append (ifile, "SEQ info_line = integer string_literal")
	call ifile_append (ifile, "QUO string_literal = '""'...'""'")
	call ifile_append (ifile, "SEQ decay_def = " &
	// "DECAY decay_spec '$' decay_data*")
	call ifile_append (ifile, "KEY DECAY")
	call ifile_append (ifile, "SEQ decay_spec = pdg_code data_item")
	call ifile_append (ifile, "ALT pdg_code = signed_integer \| integer")
	call ifile_append (ifile, "SEQ signed_integer = sign integer")
	call ifile_append (ifile, "SEQ decay_data = DATA decay_line '$'")
	call ifile_append (ifile, "SEQ decay_line = data_item integer pdg_code+")
	end subroutine define_slha_syntax

	@ %def define_slha_syntax
	@ The SLHA specification allows for string data items in certain
	places. Currently, we do not interpret them, but the strings, which
	are not quoted, must be parsed somehow. The hack for this problem is
	to allow essentially all characters as special characters, so the
	string can be read before it is discarded.
	<<SLHA: public>>=
	public :: lexer_init_slha
	<<SLHA: sub interfaces>>=
	module subroutine lexer_init_slha (lexer)
	type(lexer_t), intent(out) :: lexer
	end subroutine lexer_init_slha
	<<SLHA: procedures>>=
	module subroutine lexer_init_slha (lexer)
	type(lexer_t), intent(out) :: lexer
	call lexer_init (lexer, &
	comment_chars = "#", &
	quote_chars = '"', &
	quote_match = '"', &
	single_chars = "+-=$", &
	special_class = [ "" ], &
	keyword_list = syntax_get_keyword_list_ptr (syntax_slha), &
	upper_case_keywords = .true.) ! $
	end subroutine lexer_init_slha

	@ %def lexer_init_slha
	@
	\subsection{Interpreter}
	\subsubsection{Find blocks}
	From the parse tree, find the node that represents a particular
	block. If [[required]] is true, issue an error if not found.
	Since [[block_name]] is always invoked with capital letters, we
	have to capitalize [[pn_block_name]].
	<<SLHA: procedures>>=
	function slha_get_block_ptr &
	(parse_tree, block_name, required) result (pn_block)
	type(parse_node_t), pointer :: pn_block
	type(parse_tree_t), intent(in) :: parse_tree
	type(string_t), intent(in) :: block_name
	type(string_t) :: block_def
	logical, intent(in) :: required
	type(parse_node_t), pointer :: pn_root, pn_block_spec, pn_block_name
	pn_root => parse_tree%get_root_ptr ()
	pn_block => parse_node_get_sub_ptr (pn_root)
	do while (associated (pn_block))
	select case (char (parse_node_get_rule_key (pn_block)))
	case ("block_def")
	pn_block_spec => parse_node_get_sub_ptr (pn_block, 2)
	pn_block_name => parse_node_get_sub_ptr (pn_block_spec)
	select case (char (pn_block_name%get_rule_key ()))
	case ("block_name")
	block_def = trim (adjustl (upper_case &
	(pn_block_name%get_string ())))
	case ("QNUMBERS")
	block_def = "QNUMBERS"
	end select
	if (block_def == block_name) then
	return
	end if
	end select
	pn_block => parse_node_get_next_ptr (pn_block)
	end do
	if (required) then
	call msg_fatal ("SLHA: block '" // char (block_name) // "' not found")
	end if
	end function slha_get_block_ptr

	@ %def slha_get_blck_ptr
	@ Scan the file for the first/next DECAY block.
	<<SLHA: procedures>>=
	function slha_get_first_decay_ptr (parse_tree) result (pn_decay)
	type(parse_node_t), pointer :: pn_decay
	type(parse_tree_t), intent(in) :: parse_tree
	type(parse_node_t), pointer :: pn_root
	pn_root => parse_tree%get_root_ptr ()
	pn_decay => parse_node_get_sub_ptr (pn_root)
	do while (associated (pn_decay))
	select case (char (parse_node_get_rule_key (pn_decay)))
	case ("decay_def")
	return
	end select
	pn_decay => parse_node_get_next_ptr (pn_decay)
	end do
	end function slha_get_first_decay_ptr

	function slha_get_next_decay_ptr (pn_block) result (pn_decay)
	type(parse_node_t), pointer :: pn_decay
	type(parse_node_t), intent(in), target :: pn_block
	pn_decay => parse_node_get_next_ptr (pn_block)
	do while (associated (pn_decay))
	select case (char (parse_node_get_rule_key (pn_decay)))
	case ("decay_def")
	return
	end select
	pn_decay => parse_node_get_next_ptr (pn_decay)
	end do
	end function slha_get_next_decay_ptr

	@ %def slha_get_next_decay_ptr
	@
	\subsubsection{Extract and transfer data from blocks}
	Given the parse node of a block, find the parse node of a particular
	switch or data line. Return this node and the node of the data item
	following the integer code.
	<<SLHA: procedures>>=
	subroutine slha_find_index_ptr (pn_block, pn_data, pn_item, code)
	type(parse_node_t), intent(in), target :: pn_block
	type(parse_node_t), intent(out), pointer :: pn_data
	type(parse_node_t), intent(out), pointer :: pn_item
	integer, intent(in) :: code
	pn_data => parse_node_get_sub_ptr (pn_block, 4)
	call slha_next_index_ptr (pn_data, pn_item, code)
	end subroutine slha_find_index_ptr

	subroutine slha_find_index_pair_ptr (pn_block, pn_data, pn_item, code1, code2)
	type(parse_node_t), intent(in), target :: pn_block
	type(parse_node_t), intent(out), pointer :: pn_data
	type(parse_node_t), intent(out), pointer :: pn_item
	integer, intent(in) :: code1, code2
	pn_data => parse_node_get_sub_ptr (pn_block, 4)
	call slha_next_index_pair_ptr (pn_data, pn_item, code1, code2)
	end subroutine slha_find_index_pair_ptr

	@ %def slha_find_index_ptr slha_find_index_pair_ptr
	@ Starting from the pointer to a data line, find a data line with the
	given integer code.
	<<SLHA: procedures>>=
	subroutine slha_next_index_ptr (pn_data, pn_item, code)
	type(parse_node_t), intent(inout), pointer :: pn_data
	integer, intent(in) :: code
	type(parse_node_t), intent(out), pointer :: pn_item
	type(parse_node_t), pointer :: pn_line, pn_code
	do while (associated (pn_data))
	pn_line => parse_node_get_sub_ptr (pn_data, 2)
	pn_code => parse_node_get_sub_ptr (pn_line)
	select case (char (parse_node_get_rule_key (pn_code)))
	case ("integer")
	if (parse_node_get_integer (pn_code) == code) then
	pn_item => parse_node_get_next_ptr (pn_code)
	return
	end if
	end select
	pn_data => parse_node_get_next_ptr (pn_data)
	end do
	pn_item => null ()
	end subroutine slha_next_index_ptr

	@ %def slha_next_index_ptr
	@ Starting from the pointer to a data line, find a data line with the
	given integer code pair.
	<<SLHA: procedures>>=
	subroutine slha_next_index_pair_ptr (pn_data, pn_item, code1, code2)
	type(parse_node_t), intent(inout), pointer :: pn_data
	integer, intent(in) :: code1, code2
	type(parse_node_t), intent(out), pointer :: pn_item
	type(parse_node_t), pointer :: pn_line, pn_code1, pn_code2
	do while (associated (pn_data))
	pn_line => parse_node_get_sub_ptr (pn_data, 2)
	pn_code1 => parse_node_get_sub_ptr (pn_line)
	select case (char (parse_node_get_rule_key (pn_code1)))
	case ("integer")
	if (parse_node_get_integer (pn_code1) == code1) then
	pn_code2 => parse_node_get_next_ptr (pn_code1)
	if (associated (pn_code2)) then
	select case (char (parse_node_get_rule_key (pn_code2)))
	case ("integer")
	if (parse_node_get_integer (pn_code2) == code2) then
	pn_item => parse_node_get_next_ptr (pn_code2)
	return
	end if
	end select
	end if
	end if
	end select
	pn_data => parse_node_get_next_ptr (pn_data)
	end do
	pn_item => null ()
	end subroutine slha_next_index_pair_ptr

	@ %def slha_next_index_pair_ptr
	@
	\subsubsection{Handle info data}
	Return all strings with index [[i]]. The result is an allocated
	string array. Since we do not know the number of matching entries in
	advance, we build an intermediate list which is transferred to the
	final array and deleted before exiting.
	<<SLHA: types>>=
	type :: str_entry_t
	type(string_t) :: str
	type(str_entry_t), pointer :: next => null ()
	end type str_entry_t

	@ %def str_entry_t
	@
	<<SLHA: procedures>>=
	subroutine retrieve_strings_in_block (pn_block, code, str_array)
	type(parse_node_t), intent(in), target :: pn_block
	integer, intent(in) :: code
	type(string_t), dimension(:), allocatable, intent(out) :: str_array
	type(parse_node_t), pointer :: pn_data, pn_item
	type(str_entry_t), pointer :: first => null ()
	type(str_entry_t), pointer :: current => null ()
	integer :: n
	n = 0
	call slha_find_index_ptr (pn_block, pn_data, pn_item, code)
	if (associated (pn_item)) then
	n = n + 1
	allocate (first)
	first%str = parse_node_get_string (pn_item)
	current => first
	do while (associated (pn_data))
	pn_data => parse_node_get_next_ptr (pn_data)
	call slha_next_index_ptr (pn_data, pn_item, code)
	if (associated (pn_item)) then
	n = n + 1
	allocate (current%next)
	current => current%next
	current%str = parse_node_get_string (pn_item)
	end if
	end do
	allocate (str_array (n))
	n = 0
	do while (associated (first))
	n = n + 1
	current => first
	str_array(n) = current%str
	first => first%next
	deallocate (current)
	end do
	else
	allocate (str_array (0))
	end if
	end subroutine retrieve_strings_in_block

	@ %def retrieve_strings_in_block
	@
	\subsubsection{Transfer data from SLHA to variables}
	Extract real parameter with index [[i]]. If it does not
	exist, retrieve it from the variable list, using the given name.
	<<SLHA: procedures>>=
	function get_parameter_in_block (pn_block, code, name, var_list) result (var)
	real(default) :: var
	type(parse_node_t), intent(in), target :: pn_block
	integer, intent(in) :: code
	type(string_t), intent(in) :: name
	type(var_list_t), intent(in), target :: var_list
	type(parse_node_t), pointer :: pn_data, pn_item
	call slha_find_index_ptr (pn_block, pn_data, pn_item, code)
	if (associated (pn_item)) then
	var = get_real_parameter (pn_item)
	else
	var = var_list%get_rval (name)
	end if
	end function get_parameter_in_block

	@ %def get_parameter_in_block
	@ Extract a real data item with index [[i]]. If it
	does exist, set it in the variable list, using the given name. If
	the variable is not present in the variable list, ignore it.
	<<SLHA: procedures>>=
	subroutine set_data_item (pn_block, code, name, var_list)
	type(parse_node_t), intent(in), target :: pn_block
	integer, intent(in) :: code
	type(string_t), intent(in) :: name
	type(var_list_t), intent(inout), target :: var_list
	type(parse_node_t), pointer :: pn_data, pn_item
	call slha_find_index_ptr (pn_block, pn_data, pn_item, code)
	if (associated (pn_item)) then
	call var_list%set_real (name, get_real_parameter (pn_item), &
	is_known=.true., ignore=.true.)
	end if
	end subroutine set_data_item

	@ %def set_data_item
	@ Extract a real matrix element with index [[i,j]]. If it
	does exists, set it in the variable list, using the given name. If
	the variable is not present in the variable list, ignore it.
	<<SLHA: procedures>>=
	subroutine set_matrix_element (pn_block, code1, code2, name, var_list)
	type(parse_node_t), intent(in), target :: pn_block
	integer, intent(in) :: code1, code2
	type(string_t), intent(in) :: name
	type(var_list_t), intent(inout), target :: var_list
	type(parse_node_t), pointer :: pn_data, pn_item
	call slha_find_index_pair_ptr (pn_block, pn_data, pn_item, code1, code2)
	if (associated (pn_item)) then
	call var_list%set_real (name, get_real_parameter (pn_item), &
	is_known=.true., ignore=.true.)
	end if
	end subroutine set_matrix_element

	@ %def set_matrix_element
	@
	\subsubsection{Transfer data from variables to SLHA}
	Get a real/integer parameter with index [[i]] from the variable list and write
	it to the current output file. In the integer case, we account for
	the fact that the variable is type real. If it does not exist, do nothing.
	<<SLHA: procedures>>=
	subroutine write_integer_data_item (u, code, name, var_list, comment)
	integer, intent(in) :: u
	integer, intent(in) :: code
	type(string_t), intent(in) :: name
	type(var_list_t), intent(in) :: var_list
	character(*), intent(in) :: comment
	integer :: item
	if (var_list%contains (name)) then
	item = nint (var_list%get_rval (name))
	call write_integer_parameter (u, code, item, comment)
	end if
	end subroutine write_integer_data_item

	subroutine write_real_data_item (u, code, name, var_list, comment)
	integer, intent(in) :: u
	integer, intent(in) :: code
	type(string_t), intent(in) :: name
	type(var_list_t), intent(in) :: var_list
	character(*), intent(in) :: comment
	real(default) :: item
	if (var_list%contains (name)) then
	item = var_list%get_rval (name)
	call write_real_parameter (u, code, item, comment)
	end if
	end subroutine write_real_data_item

	@ %def write_real_data_item
	@ Get a real data item with two integer indices from the variable list
	and write it to the current output file. If it does not exist, do
	nothing.
	<<SLHA: procedures>>=
	subroutine write_matrix_element (u, code1, code2, name, var_list, comment)
	integer, intent(in) :: u
	integer, intent(in) :: code1, code2
	type(string_t), intent(in) :: name
	type(var_list_t), intent(in) :: var_list
	character(*), intent(in) :: comment
	real(default) :: item
	if (var_list%contains (name)) then
	item = var_list%get_rval (name)
	call write_real_matrix_element (u, code1, code2, item, comment)
	end if
	end subroutine write_matrix_element

	@ %def write_matrix_element
	@
	\subsection{Auxiliary function}
	Write a block header.
	<<SLHA: procedures>>=
	subroutine write_block_header (u, name, comment)
	integer, intent(in) :: u
	character(*), intent(in) :: name, comment
	write (u, "(A,1x,A,3x,'#',1x,A)") "BLOCK", name, comment
	end subroutine write_block_header

	@ %def write_block_header
	@ Extract a real parameter that may be defined real or
	integer, signed or unsigned.
	<<SLHA: procedures>>=
	function get_real_parameter (pn_item) result (var)
	real(default) :: var
	type(parse_node_t), intent(in), target :: pn_item
	type(parse_node_t), pointer :: pn_sign, pn_var
	integer :: sign
	select case (char (parse_node_get_rule_key (pn_item)))
	case ("signed_number")
	pn_sign => parse_node_get_sub_ptr (pn_item)
	pn_var => parse_node_get_next_ptr (pn_sign)
	select case (char (parse_node_get_key (pn_sign)))
	case ("+"); sign = +1
	case ("-"); sign = -1
	end select
	case default
	sign = +1
	pn_var => pn_item
	end select
	select case (char (parse_node_get_rule_key (pn_var)))
	case ("integer"); var = sign * parse_node_get_integer (pn_var)
	case ("real"); var = sign * parse_node_get_real (pn_var)
	end select
	end function get_real_parameter

	@ %def get_real_parameter
	@ Auxiliary: Extract an integer parameter that may be defined signed
	or unsigned. A real value is an error.
	<<SLHA: procedures>>=
	function get_integer_parameter (pn_item) result (var)
	integer :: var
	type(parse_node_t), intent(in), target :: pn_item
	type(parse_node_t), pointer :: pn_sign, pn_var
	integer :: sign
	select case (char (parse_node_get_rule_key (pn_item)))
	case ("signed_integer")
	pn_sign => parse_node_get_sub_ptr (pn_item)
	pn_var => parse_node_get_next_ptr (pn_sign)
	select case (char (parse_node_get_key (pn_sign)))
	case ("+"); sign = +1
	case ("-"); sign = -1
	end select
	case ("integer")
	sign = +1
	pn_var => pn_item
	case default
	call parse_node_write (pn_var)
	call msg_error ("SLHA: Integer parameter expected")
	var = 0
	return
	end select
	var = sign * parse_node_get_integer (pn_var)
	end function get_integer_parameter

	@ %def get_real_parameter
	@ Write an integer parameter with a single index directly to file,
	using the required output format.
	<<SLHA: procedures>>=
	subroutine write_integer_parameter (u, code, item, comment)
	integer, intent(in) :: u
	integer, intent(in) :: code
	integer, intent(in) :: item
	character(*), intent(in) :: comment
	1 format (1x, I9, 3x, 3x, I9, 4x, 3x, '#', 1x, A)
	write (u, 1) code, item, comment
	end subroutine write_integer_parameter

	@ %def write_integer_parameter
	@ Write a real parameter with two indices directly to file,
	using the required output format.
	<<SLHA: procedures>>=
	subroutine write_real_parameter (u, code, item, comment)
	integer, intent(in) :: u
	integer, intent(in) :: code
	real(default), intent(in) :: item
	character(*), intent(in) :: comment
	1 format (1x, I9, 3x, 1P, E16.8, 0P, 3x, '#', 1x, A)
	write (u, 1) code, item, comment
	end subroutine write_real_parameter

	@ %def write_real_parameter
	@ Write a real parameter with a single index directly to file,
	using the required output format.
	<<SLHA: procedures>>=
	subroutine write_real_matrix_element (u, code1, code2, item, comment)
	integer, intent(in) :: u
	integer, intent(in) :: code1, code2
	real(default), intent(in) :: item
	character(*), intent(in) :: comment
	1 format (1x, I2, 1x, I2, 3x, 1P, E16.8, 0P, 3x, '#', 1x, A)
	write (u, 1) code1, code2, item, comment
	end subroutine write_real_matrix_element

	@ %def write_real_matrix_element
	@
	\subsubsection{The concrete SLHA interpreter}
	SLHA codes for particular physics models
	<<SLHA: parameters>>=
	integer, parameter :: MDL_MSSM = 0
	integer, parameter :: MDL_NMSSM = 1
	@ %def MDL_MSSM MDL_NMSSM
	@ Take the parse tree and extract relevant data. Select the correct
	model and store all data that is present in the appropriate variable
	list. Finally, update the variable record.

	We assume that if the model contains custom SLHA block names, we just
	have to scan those to get complete information. Block names could
	coincide with the SLHA standard block names, but we do not have to
	assume this. This will be the situation for an UFO-generated file.
	In particular, an UFO file should contain all expressions necessary
	for computing dependent parameters, so we can forget about the strict
	SLHA standard and its hard-coded conventions.

	If there are no custom SLHA block names, we should assume that the
	model is a standard SUSY model, and the parameters and hard-coded
	blocks can be read as specified by the original SLHA standard. There
	are hard-coded block names and parameter calculations.

	Public for use in unit test.
	<<SLHA: public>>=
	public :: slha_interpret_parse_tree
	<<SLHA: sub interfaces>>=
	module subroutine slha_interpret_parse_tree &
	(parse_tree, model, input, spectrum, decays)
	type(parse_tree_t), intent(in) :: parse_tree
	type(model_t), intent(inout), target :: model
	logical, intent(in) :: input, spectrum, decays
	end subroutine slha_interpret_parse_tree
	<<SLHA: procedures>>=
	module subroutine slha_interpret_parse_tree &
	(parse_tree, model, input, spectrum, decays)
	type(parse_tree_t), intent(in) :: parse_tree
	type(model_t), intent(inout), target :: model
	logical, intent(in) :: input, spectrum, decays
	logical :: errors
	integer :: mssm_type
	if (model%supports_custom_slha ()) then
	call slha_handle_custom_file (parse_tree, model)
	else
	call slha_handle_MODSEL (parse_tree, model, mssm_type)
	if (input) then
	call slha_handle_SMINPUTS (parse_tree, model)
	call slha_handle_MINPAR (parse_tree, model, mssm_type)
	end if
	if (spectrum) then
	call slha_handle_info_block (parse_tree, "SPINFO", errors)
	if (errors) return
	call slha_handle_MASS (parse_tree, model)
	call slha_handle_matrix_block (parse_tree, "NMIX", "mn_", 4, 4, model)
	call slha_handle_matrix_block (parse_tree, "NMNMIX", "mixn_", 5, 5, model)
	call slha_handle_matrix_block (parse_tree, "UMIX", "mu_", 2, 2, model)
	call slha_handle_matrix_block (parse_tree, "VMIX", "mv_", 2, 2, model)
	call slha_handle_matrix_block (parse_tree, "STOPMIX", "mt_", 2, 2, model)
	call slha_handle_matrix_block (parse_tree, "SBOTMIX", "mb_", 2, 2, model)
	call slha_handle_matrix_block (parse_tree, "STAUMIX", "ml_", 2, 2, model)
	call slha_handle_matrix_block (parse_tree, "NMHMIX", "mixh0_", 3, 3, model)
	call slha_handle_matrix_block (parse_tree, "NMAMIX", "mixa0_", 2, 3, model)
	call slha_handle_ALPHA (parse_tree, model)
	call slha_handle_HMIX (parse_tree, model)
	call slha_handle_NMSSMRUN (parse_tree, model)
	call slha_handle_matrix_block (parse_tree, "AU", "Au_", 3, 3, model)
	call slha_handle_matrix_block (parse_tree, "AD", "Ad_", 3, 3, model)
	call slha_handle_matrix_block (parse_tree, "AE", "Ae_", 3, 3, model)
	end if
	end if
	if (decays) then
	call slha_handle_info_block (parse_tree, "DCINFO", errors)
	if (errors) return
	call slha_handle_decays (parse_tree, model)
	end if
	end subroutine slha_interpret_parse_tree

	@ %def slha_interpret_parse_tree
	@
	\subsubsection{Info blocks}
	Handle the informational blocks SPINFO and DCINFO. The first two
	items are program name and version. Items with index 3 are warnings.
	Items with index 4 are errors. We reproduce these as WHIZARD warnings
	and errors.
	<<SLHA: procedures>>=
	subroutine slha_handle_info_block (parse_tree, block_name, errors)
	type(parse_tree_t), intent(in) :: parse_tree
	character(*), intent(in) :: block_name
	logical, intent(out) :: errors
	type(parse_node_t), pointer :: pn_block
	type(string_t), dimension(:), allocatable :: msg
	integer :: i
	pn_block => slha_get_block_ptr &
	(parse_tree, var_str (block_name), required=.true.)
	if (.not. associated (pn_block)) then
	call msg_error ("SLHA: Missing info block '" &
	// trim (block_name) // "'; ignored.")
	errors = .true.
	return
	end if
	select case (block_name)
	case ("SPINFO")
	call msg_message ("SLHA: SUSY spectrum program info:")
	case ("DCINFO")
	call msg_message ("SLHA: SUSY decay program info:")
	end select
	call retrieve_strings_in_block (pn_block, 1, msg)
	do i = 1, size (msg)
	call msg_message ("SLHA: " // char (msg(i)))
	end do
	call retrieve_strings_in_block (pn_block, 2, msg)
	do i = 1, size (msg)
	call msg_message ("SLHA: " // char (msg(i)))
	end do
	call retrieve_strings_in_block (pn_block, 3, msg)
	do i = 1, size (msg)
	call msg_warning ("SLHA: " // char (msg(i)))
	end do
	call retrieve_strings_in_block (pn_block, 4, msg)
	do i = 1, size (msg)
	call msg_error ("SLHA: " // char (msg(i)))
	end do
	errors = size (msg) > 0
	end subroutine slha_handle_info_block

	@ %def slha_handle_info_block
	@
	\subsubsection{MODSEL}
	Handle the overall model definition. Only certain models are
	recognized. The soft-breaking model templates that determine the set
	of input parameters.

	This block used to be required, but for generic UFO model support we
	should allow for its absence. In that case, [[mssm_type]] will be set
	to a negative value. If the block is present, the model must be one
	of the following, or parsing ends with an error.
	<<SLHA: parameters>>=
	integer, parameter :: MSSM_GENERIC = 0
	integer, parameter :: MSSM_SUGRA = 1
	integer, parameter :: MSSM_GMSB = 2
	integer, parameter :: MSSM_AMSB = 3

	@ %def MSSM_GENERIC MSSM_MSUGRA MSSM_GMSB MSSM_AMSB
	<<SLHA: procedures>>=
	subroutine slha_handle_MODSEL (parse_tree, model, mssm_type)
	type(parse_tree_t), intent(in) :: parse_tree
	type(model_t), intent(in), target :: model
	integer, intent(out) :: mssm_type
	type(parse_node_t), pointer :: pn_block, pn_data, pn_item
	type(string_t) :: model_name
	pn_block => slha_get_block_ptr &
	(parse_tree, var_str ("MODSEL"), required=.false.)
	if (.not. associated (pn_block)) then
	mssm_type = -1
	return
	end if
	call slha_find_index_ptr (pn_block, pn_data, pn_item, 1)
	if (associated (pn_item)) then
	mssm_type = get_integer_parameter (pn_item)
	else
	mssm_type = MSSM_GENERIC
	end if
	call slha_find_index_ptr (pn_block, pn_data, pn_item, 3)
	if (associated (pn_item)) then
	select case (parse_node_get_integer (pn_item))
	case (MDL_MSSM); model_name = "MSSM"
	case (MDL_NMSSM); model_name = "NMSSM"
	case default
	call msg_fatal ("SLHA: unknown model code in MODSEL")
	return
	end select
	else
	model_name = "MSSM"
	end if
	call slha_find_index_ptr (pn_block, pn_data, pn_item, 4)
	if (associated (pn_item)) then
	call msg_fatal (" R-parity violation is currently not supported by WHIZARD.")
	end if
	call slha_find_index_ptr (pn_block, pn_data, pn_item, 5)
	if (associated (pn_item)) then
	call msg_fatal (" CP violation is currently not supported by WHIZARD.")
	end if
	select case (char (model_name))
	case ("MSSM")
	select case (char (model%get_name ()))
	case ("MSSM","MSSM_CKM","MSSM_Grav","MSSM_Hgg")
	model_name = model%get_name ()
	case default
	call msg_fatal ("Selected model '" &
	// char (model%get_name ()) // "' does not match model '" &
	// char (model_name) // "' in SLHA input file.")
	return
	end select
	case ("NMSSM")
	select case (char (model%get_name ()))
	case ("NMSSM","NMSSM_CKM","NMSSM_Hgg")
	model_name = model%get_name ()
	case default
	call msg_fatal ("Selected model '" &
	// char (model%get_name ()) // "' does not match model '" &
	// char (model_name) // "' in SLHA input file.")
	return
	end select
	case default
	call msg_bug ("SLHA model name '" &
	// char (model_name) // "' not recognized.")
	return
	end select
	call msg_message ("SLHA: Initializing model '" // char (model_name) // "'")
	end subroutine slha_handle_MODSEL

	@ %def slha_handle_MODSEL
	@ Write a MODSEL block, based on the contents of the current model.
	<<SLHA: procedures>>=
	subroutine slha_write_MODSEL (u, model, mssm_type)
	integer, intent(in) :: u
	type(model_t), intent(in), target :: model
	integer, intent(out) :: mssm_type
	type(var_list_t), pointer :: var_list
	integer :: model_id
	type(string_t) :: mtype_string
	var_list => model%get_var_list_ptr ()
	if (var_list%contains (var_str ("mtype"))) then
	mssm_type = nint (var_list%get_rval (var_str ("mtype")))
	else
	call msg_error ("SLHA: parameter 'mtype' (SUSY breaking scheme) " &
	// "is unknown in current model, no SLHA output possible")
	mssm_type = -1
	return
	end if
	call write_block_header (u, "MODSEL", "SUSY model selection")
	select case (mssm_type)
	case (0); mtype_string = "Generic MSSM"
	case (1); mtype_string = "SUGRA"
	case (2); mtype_string = "GMSB"
	case (3); mtype_string = "AMSB"
	case default
	mtype_string = "unknown"
	end select
	call write_integer_parameter (u, 1, mssm_type, &
	"SUSY-breaking scheme: " // char (mtype_string))
	select case (char (model%get_name ()))
	case ("MSSM"); model_id = MDL_MSSM
	case ("NMSSM"); model_id = MDL_NMSSM
	case default
	model_id = 0
	end select
	call write_integer_parameter (u, 3, model_id, &
	"SUSY model type: " // char (model%get_name ()))
	end subroutine slha_write_MODSEL

	@ %def slha_write_MODSEL
	@
	\subsubsection{SMINPUTS}
	Read SM parameters and update the variable list accordingly. If a
	parameter is not defined in the block, we use the previous value from
	the model variable list. For the basic parameters we have to do a
	small recalculation, since SLHA uses the $G_F$-$\alpha$-$m_Z$ scheme,
	while \whizard\ derives them from $G_F$, $m_W$, and $m_Z$.
	<<SLHA: procedures>>=
	subroutine slha_handle_SMINPUTS (parse_tree, model)
	type(parse_tree_t), intent(in) :: parse_tree
	type(model_t), intent(inout), target :: model
	type(parse_node_t), pointer :: pn_block
	real(default) :: alpha_em_i, GF, alphas, mZ
	real(default) :: ee, vv, cw_sw, cw2, mW
	real(default) :: mb, mtop, mtau
	type(var_list_t), pointer :: var_list
	var_list => model%get_var_list_ptr ()
	pn_block => slha_get_block_ptr &
	(parse_tree, var_str ("SMINPUTS"), required=.true.)
	if (.not. (associated (pn_block))) return
	alpha_em_i = &
	get_parameter_in_block (pn_block, 1, var_str ("alpha_em_i"), var_list)
	GF = get_parameter_in_block (pn_block, 2, var_str ("GF"), var_list)
	alphas = &
	get_parameter_in_block (pn_block, 3, var_str ("alphas"), var_list)
	mZ = get_parameter_in_block (pn_block, 4, var_str ("mZ"), var_list)
	mb = get_parameter_in_block (pn_block, 5, var_str ("mb"), var_list)
	mtop = get_parameter_in_block (pn_block, 6, var_str ("mtop"), var_list)
	mtau = get_parameter_in_block (pn_block, 7, var_str ("mtau"), var_list)
	ee = sqrt (4 * pi / alpha_em_i)
	vv = 1 / sqrt (sqrt (2._default) * GF)
	cw_sw = ee * vv / (2 * mZ)
	if (2*cw_sw <= 1) then
	cw2 = (1 + sqrt (1 - 4 * cw_sw**2)) / 2
	mW = mZ * sqrt (cw2)
	call var_list%set_real (var_str ("GF"), GF, .true.)
	call var_list%set_real (var_str ("mZ"), mZ, .true.)
	call var_list%set_real (var_str ("mW"), mW, .true.)
	call var_list%set_real (var_str ("mtau"), mtau, .true.)
	call var_list%set_real (var_str ("mb"), mb, .true.)
	call var_list%set_real (var_str ("mtop"), mtop, .true.)
	call var_list%set_real (var_str ("alphas"), alphas, .true.)
	else
	call msg_fatal ("SLHA: Unphysical SM parameter values")
	return
	end if
	end subroutine slha_handle_SMINPUTS

	@ %def slha_handle_SMINPUTS
	@ Write a SMINPUTS block.
	<<SLHA: procedures>>=
	subroutine slha_write_SMINPUTS (u, model)
	integer, intent(in) :: u
	type(model_t), intent(in), target :: model
	type(var_list_t), pointer :: var_list
	var_list => model%get_var_list_ptr ()
	call write_block_header (u, "SMINPUTS", "SM input parameters")
	call write_real_data_item (u, 1, var_str ("alpha_em_i"), var_list, &
	"Inverse electromagnetic coupling alpha (Z pole)")
	call write_real_data_item (u, 2, var_str ("GF"), var_list, &
	"Fermi constant")
	call write_real_data_item (u, 3, var_str ("alphas"), var_list, &
	"Strong coupling alpha_s (Z pole)")
	call write_real_data_item (u, 4, var_str ("mZ"), var_list, &
	"Z mass")
	call write_real_data_item (u, 5, var_str ("mb"), var_list, &
	"b running mass (at mb)")
	call write_real_data_item (u, 6, var_str ("mtop"), var_list, &
	"top mass")
	call write_real_data_item (u, 7, var_str ("mtau"), var_list, &
	"tau mass")
	end subroutine slha_write_SMINPUTS

	@ %def slha_write_SMINPUTS
	@
	\subsubsection{MINPAR}
	The block of SUSY input parameters. They are accessible to WHIZARD,
	but they only get used when an external spectrum generator is
	invoked. The precise set of parameters depends on the type of SUSY
	breaking, which by itself is one of the parameters.
	<<SLHA: procedures>>=
	subroutine slha_handle_MINPAR (parse_tree, model, mssm_type)
	type(parse_tree_t), intent(in) :: parse_tree
	type(model_t), intent(inout), target :: model
	integer, intent(in) :: mssm_type
	type(var_list_t), pointer :: var_list
	type(parse_node_t), pointer :: pn_block
	var_list => model%get_var_list_ptr ()
	call var_list%set_real &
	(var_str ("mtype"), real(mssm_type, default), is_known=.true.)
	pn_block => slha_get_block_ptr &
	(parse_tree, var_str ("MINPAR"), required=.true.)
	select case (mssm_type)
	case (MSSM_SUGRA)
	call set_data_item (pn_block, 1, var_str ("m_zero"), var_list)
	call set_data_item (pn_block, 2, var_str ("m_half"), var_list)
	call set_data_item (pn_block, 3, var_str ("tanb"), var_list)
	call set_data_item (pn_block, 4, var_str ("sgn_mu"), var_list)
	call set_data_item (pn_block, 5, var_str ("A0"), var_list)
	case (MSSM_GMSB)
	call set_data_item (pn_block, 1, var_str ("Lambda"), var_list)
	call set_data_item (pn_block, 2, var_str ("M_mes"), var_list)
	call set_data_item (pn_block, 3, var_str ("tanb"), var_list)
	call set_data_item (pn_block, 4, var_str ("sgn_mu"), var_list)
	call set_data_item (pn_block, 5, var_str ("N_5"), var_list)
	call set_data_item (pn_block, 6, var_str ("c_grav"), var_list)
	case (MSSM_AMSB)
	call set_data_item (pn_block, 1, var_str ("m_zero"), var_list)
	call set_data_item (pn_block, 2, var_str ("m_grav"), var_list)
	call set_data_item (pn_block, 3, var_str ("tanb"), var_list)
	call set_data_item (pn_block, 4, var_str ("sgn_mu"), var_list)
	case default
	call set_data_item (pn_block, 3, var_str ("tanb"), var_list)
	end select
	end subroutine slha_handle_MINPAR

	@ %def slha_handle_MINPAR
	@ Write a MINPAR block as appropriate for the current model type.
	<<SLHA: procedures>>=
	subroutine slha_write_MINPAR (u, model, mssm_type)
	integer, intent(in) :: u
	type(model_t), intent(in), target :: model
	integer, intent(in) :: mssm_type
	type(var_list_t), pointer :: var_list
	var_list => model%get_var_list_ptr ()
	call write_block_header (u, "MINPAR", "Basic SUSY input parameters")
	select case (mssm_type)
	case (MSSM_SUGRA)
	call write_real_data_item (u, 1, var_str ("m_zero"), var_list, &
	"Common scalar mass")
	call write_real_data_item (u, 2, var_str ("m_half"), var_list, &
	"Common gaugino mass")
	call write_real_data_item (u, 3, var_str ("tanb"), var_list, &
	"tan(beta)")
	call write_integer_data_item (u, 4, &
	var_str ("sgn_mu"), var_list, &
	"Sign of mu")
	call write_real_data_item (u, 5, var_str ("A0"), var_list, &
	"Common trilinear coupling")
	case (MSSM_GMSB)
	call write_real_data_item (u, 1, var_str ("Lambda"), var_list, &
	"Soft-breaking scale")
	call write_real_data_item (u, 2, var_str ("M_mes"), var_list, &
	"Messenger scale")
	call write_real_data_item (u, 3, var_str ("tanb"), var_list, &
	"tan(beta)")
	call write_integer_data_item (u, 4, &
	var_str ("sgn_mu"), var_list, &
	"Sign of mu")
	call write_integer_data_item (u, 5, var_str ("N_5"), var_list, &
	"Messenger index")
	call write_real_data_item (u, 6, var_str ("c_grav"), var_list, &
	"Gravitino mass factor")
	case (MSSM_AMSB)
	call write_real_data_item (u, 1, var_str ("m_zero"), var_list, &
	"Common scalar mass")
	call write_real_data_item (u, 2, var_str ("m_grav"), var_list, &
	"Gravitino mass")
	call write_real_data_item (u, 3, var_str ("tanb"), var_list, &
	"tan(beta)")
	call write_integer_data_item (u, 4, &
	var_str ("sgn_mu"), var_list, &
	"Sign of mu")
	case default
	call write_real_data_item (u, 3, var_str ("tanb"), var_list, &
	"tan(beta)")
	end select
	end subroutine slha_write_MINPAR

	@ %def slha_write_MINPAR
	@
	\subsubsection{Mass spectrum}
	Set masses. Since the particles are identified by PDG code, read
	the line and try to set the appropriate particle mass in the current
	model. At the end, update parameters, just in case the $W$ or $Z$
	mass was included.
	<<SLHA: procedures>>=
	subroutine slha_handle_MASS (parse_tree, model)
	type(parse_tree_t), intent(in) :: parse_tree
	type(model_t), intent(inout), target :: model
	type(parse_node_t), pointer :: pn_block, pn_data, pn_line, pn_code
	type(parse_node_t), pointer :: pn_mass
	integer :: pdg
	real(default) :: mass
	pn_block => slha_get_block_ptr &
	(parse_tree, var_str ("MASS"), required=.true.)
	if (.not. (associated (pn_block))) return
	pn_data => parse_node_get_sub_ptr (pn_block, 4)
	do while (associated (pn_data))
	pn_line => parse_node_get_sub_ptr (pn_data, 2)
	pn_code => parse_node_get_sub_ptr (pn_line)
	if (associated (pn_code)) then
	pdg = get_integer_parameter (pn_code)
	pn_mass => parse_node_get_next_ptr (pn_code)
	if (associated (pn_mass)) then
	mass = get_real_parameter (pn_mass)
	call model%set_field_mass (pdg, mass)
	else
	call msg_error ("SLHA: Block MASS: Missing mass value")
	end if
	else
	call msg_error ("SLHA: Block MASS: Missing PDG code")
	end if
	pn_data => parse_node_get_next_ptr (pn_data)
	end do
	end subroutine slha_handle_MASS

	@ %def slha_handle_MASS
	@
	\subsubsection{Widths}
	Set widths. For each DECAY block, extract the header, read the PDG
	code and width, and try to set the appropriate particle width in the
	current model.
	<<SLHA: procedures>>=
	subroutine slha_handle_decays (parse_tree, model)
	type(parse_tree_t), intent(in) :: parse_tree
	type(model_t), intent(inout), target :: model
	type(parse_node_t), pointer :: pn_decay, pn_decay_spec, pn_code, pn_width
	integer :: pdg
	real(default) :: width
	pn_decay => slha_get_first_decay_ptr (parse_tree)
	do while (associated (pn_decay))
	pn_decay_spec => parse_node_get_sub_ptr (pn_decay, 2)
	pn_code => parse_node_get_sub_ptr (pn_decay_spec)
	pdg = get_integer_parameter (pn_code)
	pn_width => parse_node_get_next_ptr (pn_code)
	width = get_real_parameter (pn_width)
	call model%set_field_width (pdg, width)
	pn_decay => slha_get_next_decay_ptr (pn_decay)
	end do
	end subroutine slha_handle_decays

	@ %def slha_handle_decays
	@
	\subsubsection{Mixing matrices}
	Read mixing matrices. We can treat all matrices by a single
	procedure if we just know the block name, variable prefix, and matrix
	dimension. The matrix dimension must be less than 10.
	For the pseudoscalar Higgses in NMSSM-type models we need off-diagonal
	matrices, so we generalize the definition.
	<<SLHA: procedures>>=
	subroutine slha_handle_matrix_block &
	(parse_tree, block_name, var_prefix, dim1, dim2, model)
	type(parse_tree_t), intent(in) :: parse_tree
	character(*), intent(in) :: block_name, var_prefix
	integer, intent(in) :: dim1, dim2
	type(model_t), intent(inout), target :: model
	type(parse_node_t), pointer :: pn_block
	type(var_list_t), pointer :: var_list
	integer :: i, j
	character(len=len(var_prefix)+2) :: var_name
	var_list => model%get_var_list_ptr ()
	pn_block => slha_get_block_ptr &
	(parse_tree, var_str (block_name), required=.false.)
	if (.not. (associated (pn_block))) return
	do i = 1, dim1
	do j = 1, dim2
	write (var_name, "(A,I1,I1)") var_prefix, i, j
	call set_matrix_element (pn_block, i, j, var_str (var_name), var_list)
	end do
	end do
	end subroutine slha_handle_matrix_block

	@ %def slha_handle_matrix_block
	@
	\subsubsection{Higgs data}
	Read the block ALPHA which holds just the Higgs mixing angle.
	<<SLHA: procedures>>=
	subroutine slha_handle_ALPHA (parse_tree, model)
	type(parse_tree_t), intent(in) :: parse_tree
	type(model_t), intent(inout), target :: model
	type(parse_node_t), pointer :: pn_block, pn_line, pn_data, pn_item
	type(var_list_t), pointer :: var_list
	real(default) :: al_h
	var_list => model%get_var_list_ptr ()
	pn_block => slha_get_block_ptr &
	(parse_tree, var_str ("ALPHA"), required=.false.)
	if (.not. (associated (pn_block))) return
	pn_data => parse_node_get_sub_ptr (pn_block, 4)
	pn_line => parse_node_get_sub_ptr (pn_data, 2)
	pn_item => parse_node_get_sub_ptr (pn_line)
	if (associated (pn_item)) then
	al_h = get_real_parameter (pn_item)
	call var_list%set_real (var_str ("al_h"), al_h, &
	is_known=.true., ignore=.true.)
	end if
	end subroutine slha_handle_ALPHA

	@ %def slha_handle_matrix_block
	@ Read the block HMIX for the Higgs mixing parameters
	<<SLHA: procedures>>=
	subroutine slha_handle_HMIX (parse_tree, model)
	type(parse_tree_t), intent(in) :: parse_tree
	type(model_t), intent(inout), target :: model
	type(parse_node_t), pointer :: pn_block
	type(var_list_t), pointer :: var_list
	var_list => model%get_var_list_ptr ()
	pn_block => slha_get_block_ptr &
	(parse_tree, var_str ("HMIX"), required=.false.)
	if (.not. (associated (pn_block))) return
	call set_data_item (pn_block, 1, var_str ("mu_h"), var_list)
	call set_data_item (pn_block, 2, var_str ("tanb_h"), var_list)
	end subroutine slha_handle_HMIX

	@ %def slha_handle_HMIX
	@ Read the block NMSSMRUN for the specific NMSSM parameters
	<<SLHA: procedures>>=
	subroutine slha_handle_NMSSMRUN (parse_tree, model)
	type(parse_tree_t), intent(in) :: parse_tree
	type(model_t), intent(inout), target :: model
	type(parse_node_t), pointer :: pn_block
	type(var_list_t), pointer :: var_list
	var_list => model%get_var_list_ptr ()
	pn_block => slha_get_block_ptr &
	(parse_tree, var_str ("NMSSMRUN"), required=.false.)
	if (.not. (associated (pn_block))) return
	call set_data_item (pn_block, 1, var_str ("ls"), var_list)
	call set_data_item (pn_block, 2, var_str ("ks"), var_list)
	call set_data_item (pn_block, 3, var_str ("a_ls"), var_list)
	call set_data_item (pn_block, 4, var_str ("a_ks"), var_list)
	call set_data_item (pn_block, 5, var_str ("nmu"), var_list)
	end subroutine slha_handle_NMSSMRUN

	@ %def slha_handle_NMSSMRUN
	@
	\subsection{Parsing custom SLHA files}
	With the introduction of UFO models, we support custom files in
	generic SLHA format that reset model parameters. In contrast to
	strict SLHA files, the order and naming of blocks is arbitrary.

	We scan the complete file (i.e., preprocessed parse tree), parsing all
	blocks that contain data lines. For each data line, we identify index
	array and associated value. Then we set the model parameter
	that is associated with that block name and index array, if it exists.
	<<SLHA: procedures>>=
	subroutine slha_handle_custom_file (parse_tree, model)
	type(parse_tree_t), intent(in) :: parse_tree
	type(model_t), intent(inout), target :: model

	type(parse_node_t), pointer :: pn_root, pn_block
	type(parse_node_t), pointer :: pn_block_spec, pn_block_name
	type(parse_node_t), pointer :: pn_data, pn_line, pn_code, pn_item
	type(string_t) :: block_name
	integer, dimension(:), allocatable :: block_index
	integer :: n_index, i
	real(default) :: value

	pn_root => parse_tree%get_root_ptr ()
	pn_block => pn_root%get_sub_ptr ()
	HANDLE_BLOCKS: do while (associated (pn_block))
	select case (char (pn_block%get_rule_key ()))
	case ("block_def")
	call slha_handle_custom_block (pn_block, model)
	end select
	pn_block => pn_block%get_next_ptr ()
	end do HANDLE_BLOCKS

	end subroutine slha_handle_custom_file

	@ %def slha_handle_custom_file
	@
	<<SLHA: procedures>>=
	subroutine slha_handle_custom_block (pn_block, model)
	type(parse_node_t), intent(in), target :: pn_block
	type(model_t), intent(inout), target :: model

	type(parse_node_t), pointer :: pn_block_spec, pn_block_name
	type(parse_node_t), pointer :: pn_data, pn_line, pn_code, pn_item
	type(string_t) :: block_name
	integer, dimension(:), allocatable :: block_index
	integer :: n_index, i
	real(default) :: value

	pn_block_spec => parse_node_get_sub_ptr (pn_block, 2)
	pn_block_name => parse_node_get_sub_ptr (pn_block_spec)
	select case (char (parse_node_get_rule_key (pn_block_name)))
	case ("block_name")
	block_name = trim (adjustl (upper_case (pn_block_name%get_string ())))
	case ("QNUMBERS")
	block_name = "QNUMBERS"
	end select
	call demangle_keywords (block_name)
	pn_data => pn_block%get_sub_ptr (4)
	HANDLE_LINES: do while (associated (pn_data))
	select case (char (pn_data%get_rule_key ()))
	case ("block_data")
	pn_line => pn_data%get_sub_ptr (2)
	n_index = pn_line%get_n_sub () - 1
	allocate (block_index (n_index))
	pn_code => pn_line%get_sub_ptr ()
	READ_LINE: do i = 1, n_index
	select case (char (pn_code%get_rule_key ()))
	case ("integer"); block_index(i) = pn_code%get_integer ()
	case default
	pn_code => null ()
	exit READ_LINE
	end select
	pn_code => pn_code%get_next_ptr ()
	end do READ_LINE
	if (associated (pn_code)) then
	value = get_real_parameter (pn_code)
	call model%slha_set_par (block_name, block_index, value)
	end if
	deallocate (block_index)
	end select
	pn_data => pn_data%get_next_ptr ()
	end do HANDLE_LINES

	end subroutine slha_handle_custom_block

	@ %def slha_handle_custom_block
	@
	\subsection{Parser}
	Read a SLHA file from stream, including preprocessing, and make up a
	parse tree.
	<<SLHA: procedures>>=
	subroutine slha_parse_stream (stream, custom_block_name, parse_tree)
	type(stream_t), intent(inout), target :: stream
	type(string_t), dimension(:), intent(in) :: custom_block_name
	type(parse_tree_t), intent(out) :: parse_tree
	type(ifile_t) :: ifile
	type(lexer_t) :: lexer
	type(stream_t), target :: stream_tmp
	call slha_preprocess (stream, custom_block_name, ifile)
	call stream_init (stream_tmp, ifile)
	call lexer_init_slha (lexer)
	call lexer_assign_stream (lexer, stream_tmp)
	call parse_tree_init (parse_tree, syntax_slha, lexer)
	call lexer_final (lexer)
	call stream_final (stream_tmp)
	call ifile_final (ifile)
	end subroutine slha_parse_stream

	@ %def slha_parse_stream
	@ Read a SLHA file chosen by name. Check first the current directory,
	then the directory where SUSY input files should be located.

	The [[default_mode]] applies to unknown blocks in the SLHA file: this
	is either [[MODE_SKIP]] or [[MODE_DATA]], corresponding to genuine
	SUSY and custom file content, respectively.
	<<SLHA: public>>=
	public :: slha_parse_file
	<<SLHA: sub interfaces>>=
	module subroutine slha_parse_file &
	(file, custom_block_name, os_data, parse_tree)
	type(string_t), intent(in) :: file
	type(string_t), dimension(:), intent(in) :: custom_block_name
	type(os_data_t), intent(in) :: os_data
	type(parse_tree_t), intent(out) :: parse_tree
	end subroutine slha_parse_file
	<<SLHA: procedures>>=
	module subroutine slha_parse_file &
	(file, custom_block_name, os_data, parse_tree)
	type(string_t), intent(in) :: file
	type(string_t), dimension(:), intent(in) :: custom_block_name
	type(os_data_t), intent(in) :: os_data
	type(parse_tree_t), intent(out) :: parse_tree
	logical :: exist
	type(string_t) :: filename
	type(stream_t), target :: stream
	call msg_message ("Reading SLHA input file '" // char (file) // "'")
	filename = file
	inquire (file=char(filename), exist=exist)
	if (.not. exist) then
	filename = os_data%whizard_susypath // "/" // file
	inquire (file=char(filename), exist=exist)
	if (.not. exist) then
	call msg_fatal ("SLHA input file '" // char (file) // "' not found")
	return
	end if
	end if
	call stream_init (stream, char (filename))
	call slha_parse_stream (stream, custom_block_name, parse_tree)
	call stream_final (stream)
	end subroutine slha_parse_file

	@ %def slha_parse_file
	@
	\subsection{API}
	Read the SLHA file, parse it, and interpret the parse tree. The model
	parameters retrieved from the file will be inserted into the
	appropriate model, which is loaded and modified in the background.
	The pointer to this model is returned as the last argument.
	<<SLHA: public>>=
	public :: slha_read_file
	<<SLHA: sub interfaces>>=
	module subroutine slha_read_file &
	(file, os_data, model, input, spectrum, decays)
	type(string_t), intent(in) :: file
	type(os_data_t), intent(in) :: os_data
	type(model_t), intent(inout), target :: model
	logical, intent(in) :: input, spectrum, decays
	end subroutine slha_read_file
	<<SLHA: procedures>>=
	module subroutine slha_read_file &
	(file, os_data, model, input, spectrum, decays)
	type(string_t), intent(in) :: file
	type(os_data_t), intent(in) :: os_data
	type(model_t), intent(inout), target :: model
	logical, intent(in) :: input, spectrum, decays
	type(string_t), dimension(:), allocatable :: custom_block_name
	type(parse_tree_t) :: parse_tree
	call model%get_custom_slha_blocks (custom_block_name)
	call slha_parse_file (file, custom_block_name, os_data, parse_tree)
	if (associated (parse_tree%get_root_ptr ())) then
	call slha_interpret_parse_tree &
	(parse_tree, model, input, spectrum, decays)
	call parse_tree_final (parse_tree)
	call model%update_parameters ()
	end if
	end subroutine slha_read_file

	@ %def slha_read_file
	@ Write the SLHA contents, as far as possible, to external file.
	<<SLHA: public>>=
	public :: slha_write_file
	<<SLHA: sub interfaces>>=
	module subroutine slha_write_file (file, model, input, spectrum, decays)
	type(string_t), intent(in) :: file
	type(model_t), target, intent(in) :: model
	logical, intent(in) :: input, spectrum, decays
	end subroutine slha_write_file
	<<SLHA: procedures>>=
	module subroutine slha_write_file (file, model, input, spectrum, decays)
	type(string_t), intent(in) :: file
	type(model_t), target, intent(in) :: model
	logical, intent(in) :: input, spectrum, decays
	integer :: mssm_type
	integer :: u
	u = free_unit ()
	call msg_message ("Writing SLHA output file '" // char (file) // "'")
	open (unit=u, file=char(file), action="write", status="replace")
	write (u, "(A)") "# SUSY Les Houches Accord"
	write (u, "(A)") "# Output generated by " // trim (VERSION_STRING)
	call slha_write_MODSEL (u, model, mssm_type)
	if (input) then
	call slha_write_SMINPUTS (u, model)
	call slha_write_MINPAR (u, model, mssm_type)
	end if
	if (spectrum) then
	call msg_bug ("SLHA: spectrum output not supported yet")
	end if
	if (decays) then
	call msg_bug ("SLHA: decays output not supported yet")
	end if
	close (u)
	end subroutine slha_write_file

	@ %def slha_write_file
	@
	\subsection{Dispatch}
	<<SLHA: public>>=
	public :: dispatch_slha
	<<SLHA: sub interfaces>>=
	module subroutine dispatch_slha (var_list, input, spectrum, decays)
	type(var_list_t), intent(inout), target :: var_list
	logical, intent(out) :: input, spectrum, decays
	end subroutine dispatch_slha
	<<SLHA: procedures>>=
	module subroutine dispatch_slha (var_list, input, spectrum, decays)
	type(var_list_t), intent(inout), target :: var_list
	logical, intent(out) :: input, spectrum, decays
	input = var_list%get_lval (var_str ("?slha_read_input"))
	spectrum = var_list%get_lval (var_str ("?slha_read_spectrum"))
	decays = var_list%get_lval (var_str ("?slha_read_decays"))
	end subroutine dispatch_slha

	@ %def dispatch_slha
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[slha_interface_ut.f90]]>>=
	<<File header>>

	module slha_interface_ut
	use unit_tests
	use slha_interface_uti

	<<Standard module head>>

	<<SLHA: public test>>

	contains

	<<SLHA: test driver>>

	end module slha_interface_ut
	@ %def slha_interface_ut
	@
	<<[[slha_interface_uti.f90]]>>=
	<<File header>>

	module slha_interface_uti

	<<Use strings>>
	use io_units
	use os_interface
	use parser
	use model_data
	use variables
	use models

	use slha_interface

	<<Standard module head>>

	<<SLHA: test declarations>>

	contains

	<<SLHA: tests>>

	end module slha_interface_uti
	@ %def slha_interface_ut
	@ API: driver for the unit tests below.
	<<SLHA: public test>>=
	public :: slha_test
	<<SLHA: test driver>>=
	subroutine slha_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SLHA: execute tests>>
	end subroutine slha_test

	@ %def slha_test
	@ Checking the basics of the SLHA interface.
	<<SLHA: execute tests>>=
	call test (slha_1, "slha_1", &
	"check SLHA interface", &
	u, results)
	<<SLHA: test declarations>>=
	public :: slha_1
	<<SLHA: tests>>=
	subroutine slha_1 (u)
	integer, intent(in) :: u
	type(os_data_t), pointer :: os_data => null ()
	type(parse_tree_t), pointer :: parse_tree => null ()
	integer :: u_file, iostat
	character(80) :: buffer
	character(*), parameter :: file_slha = "slha_test.dat"
	type(model_list_t) :: model_list
	type(model_t), pointer :: model => null ()
	type(var_list_t), pointer :: var_list
	type(string_t), dimension(0) :: empty_string_array

	write (u, "(A)") "* Test output: SLHA Interface"
	write (u, "(A)") "* Purpose: test SLHA file reading and writing"
	write (u, "(A)")

	write (u, "(A)") "* Initializing"
	write (u, "(A)")

	allocate (os_data)
	allocate (parse_tree)
	call os_data%init ()
	call syntax_model_file_init ()
	call model_list%read_model &
	(var_str("MSSM"), var_str("MSSM.mdl"), os_data, model)
	call syntax_slha_init ()

	write (u, "(A)") "* Reading SLHA file sps1ap_decays.slha"
	write (u, "(A)")

	call slha_parse_file (var_str ("sps1ap_decays.slha"), &
	empty_string_array, os_data, parse_tree)

	write (u, "(A)") "* Writing the parse tree:"
	write (u, "(A)")

	call parse_tree_write (parse_tree, u)

	write (u, "(A)") "* Interpreting the parse tree"
	write (u, "(A)")

	call slha_interpret_parse_tree (parse_tree, model, &
	input=.true., spectrum=.true., decays=.true.)
	call parse_tree_final (parse_tree)

	write (u, "(A)") "* Writing out the list of variables (reals only):"
	write (u, "(A)")

	var_list => model%get_var_list_ptr ()
	call var_list%write (only_type = V_REAL, unit = u)

	write (u, "(A)")
	write (u, "(A)") "* Writing SLHA output to '" // file_slha // "'"
	write (u, "(A)")

	call slha_write_file (var_str (file_slha), model, input=.true., &
	spectrum=.false., decays=.false.)
	u_file = free_unit ()
	open (u_file, file = file_slha, action = "read", status = "old")
	do
	read (u_file, "(A)", iostat = iostat) buffer
	if (buffer(1:37) == "# Output generated by WHIZARD version") then
	buffer = "[...]"
	end if
	if (iostat /= 0) exit
	write (u, "(A)") trim (buffer)
	end do
	close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"
	write (u, "(A)")

	call parse_tree_final (parse_tree)
	deallocate (parse_tree)
	deallocate (os_data)

	write (u, "(A)") "* Test output end: slha_1"
	write (u, "(A)")

	end subroutine slha_1

	@ %def slha_1
	@
	\subsubsection{SLHA interface}
	This rather trivial sets all input values for the SLHA interface
	to [[false]].
	<<SLHA: execute tests>>=
	call test (slha_2, "slha_2", &
	"SLHA interface", &
	u, results)
	<<SLHA: test declarations>>=
	public :: slha_2
	<<SLHA: tests>>=
	subroutine slha_2 (u)
	integer, intent(in) :: u
	type(var_list_t) :: var_list
	logical :: input, spectrum, decays

	write (u, "(A)") "* Test output: slha_2"
	write (u, "(A)") "* Purpose: SLHA interface settings"
	write (u, "(A)")

	write (u, "(A)") "* Default settings"
	write (u, "(A)")

	call var_list%init_defaults (0)
	call dispatch_slha (var_list, &
	input = input, spectrum = spectrum, decays = decays)

	write (u, "(A,1x,L1)") " slha_read_input =", input
	write (u, "(A,1x,L1)") " slha_read_spectrum =", spectrum
	write (u, "(A,1x,L1)") " slha_read_decays =", decays

	call var_list%final ()
	call var_list%init_defaults (0)

	write (u, "(A)")
	write (u, "(A)") "* Set all entries to [false]"
	write (u, "(A)")

	call var_list%set_log (var_str ("?slha_read_input"), &
	.false., is_known = .true.)
	call var_list%set_log (var_str ("?slha_read_spectrum"), &
	.false., is_known = .true.)
	call var_list%set_log (var_str ("?slha_read_decays"), &
	.false., is_known = .true.)

	call dispatch_slha (var_list, &
	input = input, spectrum = spectrum, decays = decays)

	write (u, "(A,1x,L1)") " slha_read_input =", input
	write (u, "(A,1x,L1)") " slha_read_spectrum =", spectrum
	write (u, "(A,1x,L1)") " slha_read_decays =", decays

	call var_list%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: slha_2"

	end subroutine slha_2

	@ %def slha_2
	Index: trunk/src/whizard-core/whizard.nw
	===================================================================
	--- trunk/src/whizard-core/whizard.nw (revision 8903)
	+++ trunk/src/whizard-core/whizard.nw (revision 8904)
	@@ -1,31838 +1,31838 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD main code as NOWEB source
	\includemodulegraph{whizard-core}
	\chapter{Integration and Simulation}
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{User-controlled File I/O}

	The SINDARIN language includes commands that write output to file (input may
	be added later). We identify files by their name, and manage the unit
	internally. We need procedures for opening, closing, and printing files.

	<<[[user_files.f90]]>>=
	<<File header>>

	module user_files

	<<Use strings>>
	use ifiles

	<<Standard module head>>

	<<User files: public>>

	<<User files: types>>

	<<User files: interfaces>>

	interface
	<<User files: sub interfaces>>
	end interface

	end module user_files
	@ %def user_files
	@
	<<[[user_files_sub.f90]]>>=
	<<File header>>

	submodule (user_files) user_files_s

	use io_units
	use diagnostics
	use analysis

	implicit none

	contains

	<<User files: procedures>>

	end submodule user_files_s

	@ %def user_files_s
	@
	\subsection{The file type}
	This is a type that describes an open user file and its properties. The entry
	is part of a doubly-linked list.
	<<User files: types>>=
	type :: file_t
	private
	type(string_t) :: name
	integer :: unit = -1
	logical :: reading = .false.
	logical :: writing = .false.
	type(file_t), pointer :: prev => null ()
	type(file_t), pointer :: next => null ()
	end type file_t

	@ %def file_t
	@ The initializer opens the file.
	<<User files: procedures>>=
	subroutine file_init (file, name, action, status, position)
	type(file_t), intent(out) :: file
	type(string_t), intent(in) :: name
	character(len=*), intent(in) :: action, status, position
	file%unit = free_unit ()
	file%name = name
	open (unit = file%unit, file = char (file%name), &
	action = action, status = status, position = position)
	select case (action)
	case ("read")
	file%reading = .true.
	case ("write")
	file%writing = .true.
	case ("readwrite")
	file%reading = .true.
	file%writing = .true.
	end select
	end subroutine file_init

	@ %def file_init
	@ The finalizer closes it.
	<<User files: procedures>>=
	subroutine file_final (file)
	type(file_t), intent(inout) :: file
	close (unit = file%unit)
	file%unit = -1
	end subroutine file_final

	@ %def file_final
	@ Check if a file is open with correct status.
	<<User files: procedures>>=
	function file_is_open (file, action) result (flag)
	logical :: flag
	type(file_t), intent(in) :: file
	character(*), intent(in) :: action
	select case (action)
	case ("read")
	flag = file%reading
	case ("write")
	flag = file%writing
	case ("readwrite")
	flag = file%reading .and. file%writing
	case default
	call msg_bug ("Checking file '" // char (file%name) &
	// "': illegal action specifier")
	end select
	end function file_is_open

	@ %def file_is_open
	@ Return the unit number of a file for direct access. It should be checked
	first whether the file is open.
	<<User files: procedures>>=
	function file_get_unit (file) result (unit)
	integer :: unit
	type(file_t), intent(in) :: file
	unit = file%unit
	end function file_get_unit

	@ %def file_get_unit
	@ Write to the file. Error if in wrong mode. If there is no string, just
	write an empty record. If there is a string, respect the [[advancing]]
	option.
	<<User files: procedures>>=
	subroutine file_write_string (file, string, advancing)
	type(file_t), intent(in) :: file
	type(string_t), intent(in), optional :: string
	logical, intent(in), optional :: advancing
	if (file%writing) then
	if (present (string)) then
	if (present (advancing)) then
	if (advancing) then
	write (file%unit, "(A)") char (string)
	else
	write (file%unit, "(A)", advance="no") char (string)
	end if
	else
	write (file%unit, "(A)") char (string)
	end if
	else
	write (file%unit, *)
	end if
	else
	call msg_error ("Writing to file: File '" // char (file%name) &
	// "' is not open for writing.")
	end if
	end subroutine file_write_string

	@ %def file_write
	@ Write a whole ifile, line by line.
	<<User files: procedures>>=
	subroutine file_write_ifile (file, ifile)
	type(file_t), intent(in) :: file
	type(ifile_t), intent(in) :: ifile
	type(line_p) :: line
	call line_init (line, ifile)
	do while (line_is_associated (line))
	call file_write_string (file, line_get_string_advance (line))
	end do
	end subroutine file_write_ifile

	@ %def file_write_ifile
	@ Write an analysis object (or all objects) to an open file.
	<<User files: procedures>>=
	subroutine file_write_analysis (file, tag)
	type(file_t), intent(in) :: file
	type(string_t), intent(in), optional :: tag
	if (file%writing) then
	if (present (tag)) then
	call analysis_write (tag, unit = file%unit)
	else
	call analysis_write (unit = file%unit)
	end if
	else
	call msg_error ("Writing analysis to file: File '" // char (file%name) &
	// "' is not open for writing.")
	end if
	end subroutine file_write_analysis

	@ %def file_write_analysis
	@
	\subsection{The file list}
	We maintain a list of all open files and their attributes. The list must be
	doubly-linked because we may delete entries.
	<<User files: public>>=
	public :: file_list_t
	<<User files: types>>=
	type :: file_list_t
	type(file_t), pointer :: first => null ()
	type(file_t), pointer :: last => null ()
	end type file_list_t

	@ %def file_list_t
	@ There is no initialization routine, but a finalizer which deletes all:
	<<User files: public>>=
	public :: file_list_final
	<<User files: sub interfaces>>=
	module subroutine file_list_final (file_list)
	type(file_list_t), intent(inout) :: file_list
	end subroutine file_list_final
	<<User files: procedures>>=
	module subroutine file_list_final (file_list)
	type(file_list_t), intent(inout) :: file_list
	type(file_t), pointer :: current
	do while (associated (file_list%first))
	current => file_list%first
	file_list%first => current%next
	call file_final (current)
	deallocate (current)
	end do
	file_list%last => null ()
	end subroutine file_list_final

	@ %def file_list_final
	@ Find an entry in the list. Return null pointer on failure.
	<<User files: procedures>>=
	function file_list_get_file_ptr (file_list, name) result (current)
	type(file_t), pointer :: current
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	current => file_list%first
	do while (associated (current))
	if (current%name == name) return
	current => current%next
	end do
	end function file_list_get_file_ptr

	@ %def file_list_get_file_ptr
	@ Check if a file is open, public version:
	<<User files: public>>=
	public :: file_list_is_open
	<<User files: sub interfaces>>=
	module function file_list_is_open (file_list, name, action) result (flag)
	logical :: flag
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	character(len=*), intent(in) :: action
	end function file_list_is_open
	<<User files: procedures>>=
	module function file_list_is_open (file_list, name, action) result (flag)
	logical :: flag
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	character(len=*), intent(in) :: action
	type(file_t), pointer :: current
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	flag = file_is_open (current, action)
	else
	flag = .false.
	end if
	end function file_list_is_open

	@ %def file_list_is_open
	@ Return the unit number for a file. It should be checked first whether the
	file is open.
	<<User files: public>>=
	public :: file_list_get_unit
	<<User files: sub interfaces>>=
	module function file_list_get_unit (file_list, name) result (unit)
	integer :: unit
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	end function file_list_get_unit
	<<User files: procedures>>=
	module function file_list_get_unit (file_list, name) result (unit)
	integer :: unit
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	type(file_t), pointer :: current
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	unit = file_get_unit (current)
	else
	unit = -1
	end if
	end function file_list_get_unit

	@ %def file_list_get_unit
	@ Append a new file entry, i.e., open this file. Error if it is
	already open.
	<<User files: public>>=
	public :: file_list_open
	<<User files: sub interfaces>>=
	module subroutine file_list_open (file_list, name, action, status, position)
	type(file_list_t), intent(inout) :: file_list
	type(string_t), intent(in) :: name
	character(len=*), intent(in) :: action, status, position
	end subroutine file_list_open
	<<User files: procedures>>=
	module subroutine file_list_open (file_list, name, action, status, position)
	type(file_list_t), intent(inout) :: file_list
	type(string_t), intent(in) :: name
	character(len=*), intent(in) :: action, status, position
	type(file_t), pointer :: current
	if (.not. associated (file_list_get_file_ptr (file_list, name))) then
	allocate (current)
	call msg_message ("Opening file '" // char (name) // "' for output")
	call file_init (current, name, action, status, position)
	if (associated (file_list%last)) then
	file_list%last%next => current
	current%prev => file_list%last
	else
	file_list%first => current
	end if
	file_list%last => current
	else
	call msg_error ("Opening file: File '" // char (name) &
	// "' is already open.")
	end if
	end subroutine file_list_open

	@ %def file_list_open
	@ Delete a file entry, i.e., close this file. Error if it is not open.
	<<User files: public>>=
	public :: file_list_close
	<<User files: sub interfaces>>=
	module subroutine file_list_close (file_list, name)
	type(file_list_t), intent(inout) :: file_list
	type(string_t), intent(in) :: name
	end subroutine file_list_close
	<<User files: procedures>>=
	module subroutine file_list_close (file_list, name)
	type(file_list_t), intent(inout) :: file_list
	type(string_t), intent(in) :: name
	type(file_t), pointer :: current
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	if (associated (current%prev)) then
	current%prev%next => current%next
	else
	file_list%first => current%next
	end if
	if (associated (current%next)) then
	current%next%prev => current%prev
	else
	file_list%last => current%prev
	end if
	call msg_message ("Closing file '" // char (name) // "' for output")
	call file_final (current)
	deallocate (current)
	else
	call msg_error ("Closing file: File '" // char (name) &
	// "' is not open.")
	end if
	end subroutine file_list_close

	@ %def file_list_close
	@ Write a string to file. Error if it is not open.
	<<User files: public>>=
	public :: file_list_write
	<<User files: interfaces>>=
	interface file_list_write
	module procedure file_list_write_string
	module procedure file_list_write_ifile
	end interface
	<<User files: sub interfaces>>=
	module subroutine file_list_write_ifile (file_list, name, ifile)
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	type(ifile_t), intent(in) :: ifile
	end subroutine file_list_write_ifile
	module subroutine file_list_write_string &
	(file_list, name, string, advancing)
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: string
	logical, intent(in), optional :: advancing
	end subroutine file_list_write_string
	<<User files: procedures>>=
	module subroutine file_list_write_string (file_list, name, string, advancing)
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: string
	logical, intent(in), optional :: advancing
	type(file_t), pointer :: current
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	call file_write_string (current, string, advancing)
	else
	call msg_error ("Writing to file: File '" // char (name) &
	// "'is not open.")
	end if
	end subroutine file_list_write_string

	module subroutine file_list_write_ifile (file_list, name, ifile)
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	type(ifile_t), intent(in) :: ifile
	type(file_t), pointer :: current
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	call file_write_ifile (current, ifile)
	else
	call msg_error ("Writing to file: File '" // char (name) &
	// "'is not open.")
	end if
	end subroutine file_list_write_ifile

	@ %def file_list_write
	@ Write an analysis object or all objects to data file. Error if it is not
	open. If the file name is empty, write to standard output.
	<<User files: public>>=
	public :: file_list_write_analysis
	<<User files: sub interfaces>>=
	module subroutine file_list_write_analysis (file_list, name, tag)
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: tag
	end subroutine file_list_write_analysis
	<<User files: procedures>>=
	module subroutine file_list_write_analysis (file_list, name, tag)
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: tag
	type(file_t), pointer :: current
	if (name == "") then
	if (present (tag)) then
	call analysis_write (tag)
	else
	call analysis_write
	end if
	else
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	call file_write_analysis (current, tag)
	else
	call msg_error ("Writing analysis to file: File '" // char (name) &
	// "' is not open.")
	end if
	end if
	end subroutine file_list_write_analysis

	@ %def file_list_write_analysis
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Runtime data}

	<<[[rt_data.f90]]>>=
	<<File header>>

	module rt_data

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use lexers
	use parser
	use models
	use subevents
	use pdg_arrays
	use variables, only: var_list_t
	use process_libraries
	use prclib_stacks
	use prc_core, only: helicity_selection_t
	use beam_structures
	use event_base, only: event_callback_t
	use user_files
	use process_stacks
	use iterations

	<<Standard module head>>

	<<RT data: public>>

	<<RT data: types>>

	interface
	<<RT data: sub interfaces>>
	end interface

	contains

	<<RT data: main procedures>>

	end module rt_data
	@ %def rt_data
	@
	<<[[rt_data_sub.f90]]>>=
	<<File header>>

	submodule (rt_data) rt_data_s

	use io_units
	use format_utils, only: write_separator
	use format_defs, only: FMT_19, FMT_12
	use system_dependencies
	use diagnostics
	!!! Intel oneAPI 2022/23 regression workaround
	use variables, only: var_list_t
	use prc_core, only: helicity_selection_t

	implicit none

	contains

	<<RT data: procedures>>

	end submodule rt_data_s

	@ %def rt_data_s
	@
	\subsection{Strategy for models and variables}
	The program manages its data via a main [[rt_data_t]] object. During program
	flow, various commands create and use local [[rt_data_t]] objects. Those
	transient blocks contain either pointers to global object or local copies
	which are deleted after use.

	Each [[rt_data_t]] object contains a variable list component. This lists
	holds (local copies of) all kinds of intrinsic or user-defined variables. The
	variable list is linked to the variable list contained in the local process
	library. This, in turn, is linked to the variable list of the [[rt_data_t]]
	context, and so on.

	A variable lookup will thus be recursively delegated to the linked variable
	lists, until a match is found. When modifying a variable which is not yet
	local, the program creates a local copy and uses this afterwards. Thus, when
	the local [[rt_data_t]] object is deleted, the context value is recovered.

	Models are kept in a model list which is separate from the variable list.
	Otherwise, they are treated in a similar manner: the local list is linked to
	the context model list. Model lookup is thus recursively delegated. When a
	model or any part of it is modified, the model is copied to the local
	[[rt_data_t]] object, so the context model is not modified. Commands such as
	[[integrate]] will create their own copy of the current model (and of the
	current variable list) at the point where they are executed.

	When a model is encountered for the first time, it is read from file. The
	reading is automatically delegated to the global context. Thus, this master
	copy survives until the main [[rt_data_t]] object is deleted, at program
	completion.

	If there is a currently active model, its variable list is linked to the main
	variable list. Variable lookups will then start from the model variable
	list. When the current model is switched, the new active model will get this
	link instead. Consequently, a change to the current model is kept as long as
	this model has a local copy; it survives local model switches. On the other
	hand, a parameter change in the current model doesn't affect any other model,
	even if the parameter name is identical.
	@
	\subsection{Container for parse nodes}
	The runtime data set contains a bunch of parse nodes (chunks of code
	that have not been compiled into evaluation trees but saved for later
	use). We collect them here.

	This implementation has the useful effect that an assignment between two
	objects of this type will establish a pointer-target relationship for
	all components.
	<<RT data: types>>=
	type :: rt_parse_nodes_t
	type(parse_node_t), pointer :: cuts_lexpr => null ()
	type(parse_node_t), pointer :: scale_expr => null ()
	type(parse_node_t), pointer :: fac_scale_expr => null ()
	type(parse_node_t), pointer :: ren_scale_expr => null ()
	type(parse_node_t), pointer :: weight_expr => null ()
	type(parse_node_t), pointer :: selection_lexpr => null ()
	type(parse_node_t), pointer :: reweight_expr => null ()
	type(parse_node_t), pointer :: analysis_lexpr => null ()
	type(parse_node_p), dimension(:), allocatable :: alt_setup
	contains
	<<RT data: rt parse nodes: TBP>>
	end type rt_parse_nodes_t

	@ %def rt_parse_nodes_t
	@ Clear individual components. The parse nodes are nullified. No
	finalization needed since the pointer targets are part of the global
	parse tree.
	<<RT data: rt parse nodes: TBP>>=
	procedure :: clear => rt_parse_nodes_clear
	<<RT data: sub interfaces>>=
	module subroutine rt_parse_nodes_clear (rt_pn, name)
	class(rt_parse_nodes_t), intent(inout) :: rt_pn
	type(string_t), intent(in) :: name
	end subroutine rt_parse_nodes_clear
	<<RT data: procedures>>=
	module subroutine rt_parse_nodes_clear (rt_pn, name)
	class(rt_parse_nodes_t), intent(inout) :: rt_pn
	type(string_t), intent(in) :: name
	select case (char (name))
	case ("cuts")
	rt_pn%cuts_lexpr => null ()
	case ("scale")
	rt_pn%scale_expr => null ()
	case ("factorization_scale")
	rt_pn%fac_scale_expr => null ()
	case ("renormalization_scale")
	rt_pn%ren_scale_expr => null ()
	case ("weight")
	rt_pn%weight_expr => null ()
	case ("selection")
	rt_pn%selection_lexpr => null ()
	case ("reweight")
	rt_pn%reweight_expr => null ()
	case ("analysis")
	rt_pn%analysis_lexpr => null ()
	end select
	end subroutine rt_parse_nodes_clear

	@ %def rt_parse_nodes_clear
	@ Output for the parse nodes.
	<<RT data: rt parse nodes: TBP>>=
	procedure :: write => rt_parse_nodes_write
	<<RT data: sub interfaces>>=
	module subroutine rt_parse_nodes_write (object, unit)
	class(rt_parse_nodes_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine rt_parse_nodes_write
	<<RT data: procedures>>=
	module subroutine rt_parse_nodes_write (object, unit)
	class(rt_parse_nodes_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	call wrt ("Cuts", object%cuts_lexpr)
	call write_separator (u)
	call wrt ("Scale", object%scale_expr)
	call write_separator (u)
	call wrt ("Factorization scale", object%fac_scale_expr)
	call write_separator (u)
	call wrt ("Renormalization scale", object%ren_scale_expr)
	call write_separator (u)
	call wrt ("Weight", object%weight_expr)
	call write_separator (u, 2)
	call wrt ("Event selection", object%selection_lexpr)
	call write_separator (u)
	call wrt ("Event reweighting factor", object%reweight_expr)
	call write_separator (u)
	call wrt ("Event analysis", object%analysis_lexpr)
	if (allocated (object%alt_setup)) then
	call write_separator (u, 2)
	write (u, "(1x,A,':')") "Alternative setups"
	do i = 1, size (object%alt_setup)
	call write_separator (u)
	call wrt ("Commands", object%alt_setup(i)%ptr)
	end do
	end if
	contains
	subroutine wrt (title, pn)
	character(*), intent(in) :: title
	type(parse_node_t), intent(in), pointer :: pn
	if (associated (pn)) then
	write (u, "(1x,A,':')") title
	call write_separator (u)
	call parse_node_write_rec (pn, u)
	else
	write (u, "(1x,A,':',1x,A)") title, "[undefined]"
	end if
	end subroutine wrt
	end subroutine rt_parse_nodes_write

	@ %def rt_parse_nodes_write
	@ Screen output for individual components. (This should eventually be more
	condensed, currently we print the internal representation tree.)
	<<RT data: rt parse nodes: TBP>>=
	procedure :: show => rt_parse_nodes_show
	<<RT data: sub interfaces>>=
	module subroutine rt_parse_nodes_show (rt_pn, name, unit)
	class(rt_parse_nodes_t), intent(in) :: rt_pn
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: unit
	end subroutine rt_parse_nodes_show
	<<RT data: procedures>>=
	module subroutine rt_parse_nodes_show (rt_pn, name, unit)
	class(rt_parse_nodes_t), intent(in) :: rt_pn
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: unit
	type(parse_node_t), pointer :: pn
	integer :: u
	u = given_output_unit (unit)
	select case (char (name))
	case ("cuts")
	pn => rt_pn%cuts_lexpr
	case ("scale")
	pn => rt_pn%scale_expr
	case ("factorization_scale")
	pn => rt_pn%fac_scale_expr
	case ("renormalization_scale")
	pn => rt_pn%ren_scale_expr
	case ("weight")
	pn => rt_pn%weight_expr
	case ("selection")
	pn => rt_pn%selection_lexpr
	case ("reweight")
	pn => rt_pn%reweight_expr
	case ("analysis")
	pn => rt_pn%analysis_lexpr
	end select
	if (associated (pn)) then
	write (u, "(A,1x,A,1x,A)") "Expression:", char (name), "(parse tree):"
	call parse_node_write_rec (pn, u)
	else
	write (u, "(A,1x,A,A)") "Expression:", char (name), ": [undefined]"
	end if
	end subroutine rt_parse_nodes_show

	@ %def rt_parse_nodes_show
	@
	\subsection{The data type}
	This is a big data container which contains everything that is used and
	modified during the command flow. A local copy of this can be used to
	temporarily override defaults. The data set is transparent.
	<<RT data: public>>=
	public :: rt_data_t
	<<RT data: types>>=
	type :: rt_data_t
	type(lexer_t), pointer :: lexer => null ()
	type(rt_data_t), pointer :: context => null ()
	type(string_t), dimension(:), allocatable :: export
	type(var_list_t) :: var_list
	type(iterations_list_t) :: it_list
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(model_t), pointer :: model => null ()
	logical :: model_is_copy = .false.
	type(model_t), pointer :: preload_model => null ()
	type(model_t), pointer :: fallback_model => null ()
	type(prclib_stack_t) :: prclib_stack
	type(process_library_t), pointer :: prclib => null ()
	type(beam_structure_t) :: beam_structure
	type(rt_parse_nodes_t) :: pn
	type(process_stack_t) :: process_stack
	type(string_t), dimension(:), allocatable :: sample_fmt
	class(event_callback_t), allocatable :: event_callback
	type(file_list_t), pointer :: out_files => null ()
	logical :: quit = .false.
	integer :: quit_code = 0
	type(string_t) :: logfile
	logical :: nlo_fixed_order = .false.
	logical, dimension(0:5) :: selected_nlo_parts = .false.
	integer, dimension(:), allocatable :: nlo_component
	contains
	<<RT data: rt data: TBP>>
	end type rt_data_t

	@ %def rt_data_t
	@
	\subsection{Output}
	<<RT data: rt data: TBP>>=
	procedure :: write => rt_data_write
	<<RT data: sub interfaces>>=
	module subroutine rt_data_write (object, unit, vars, pacify)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	type(string_t), dimension(:), intent(in), optional :: vars
	logical, intent(in), optional :: pacify
	end subroutine rt_data_write
	<<RT data: procedures>>=
	module subroutine rt_data_write (object, unit, vars, pacify)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	type(string_t), dimension(:), intent(in), optional :: vars
	logical, intent(in), optional :: pacify
	integer :: u, i
	u = given_output_unit (unit)
	call write_separator (u, 2)
	write (u, "(1x,A)") "Runtime data:"
	if (object%get_n_export () > 0) then
	call write_separator (u, 2)
	write (u, "(1x,A)") "Exported objects and variables:"
	call write_separator (u)
	call object%write_exports (u)
	end if
	if (present (vars)) then
	if (size (vars) /= 0) then
	call write_separator (u, 2)
	write (u, "(1x,A)") "Selected variables:"
	call write_separator (u)
	call object%write_vars (u, vars)
	end if
	else
	call write_separator (u, 2)
	if (associated (object%model)) then
	call object%model%write_var_list (u, follow_link=.true.)
	else
	call object%var_list%write (u, follow_link=.true.)
	end if
	end if
	if (object%it_list%get_n_pass () > 0) then
	call write_separator (u, 2)
	write (u, "(1x)", advance="no")
	call object%it_list%write (u)
	end if
	if (associated (object%model)) then
	call write_separator (u, 2)
	call object%model%write (u)
	end if
	call object%prclib_stack%write (u)
	call object%beam_structure%write (u)
	call write_separator (u, 2)
	call object%pn%write (u)
	if (allocated (object%sample_fmt)) then
	call write_separator (u)
	write (u, "(1x,A)", advance="no") "Event sample formats = "
	do i = 1, size (object%sample_fmt)
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (object%sample_fmt(i))
	end do
	write (u, "(A)")
	end if
	call write_separator (u)
	write (u, "(1x,A)", advance="no") "Event callback:"
	if (allocated (object%event_callback)) then
	call object%event_callback%write (u)
	else
	write (u, "(1x,A)") "[undefined]"
	end if
	call object%process_stack%write (u, pacify)
	write (u, "(1x,A,1x,L1)") "quit :", object%quit
	write (u, "(1x,A,1x,I0)") "quit_code:", object%quit_code
	call write_separator (u, 2)
	write (u, "(1x,A,1x,A)") "Logfile :", "'" // trim (char (object%logfile)) // "'"
	call write_separator (u, 2)
	end subroutine rt_data_write

	@ %def rt_data_write
	@ Write only selected variables.
	<<RT data: rt data: TBP>>=
	procedure :: write_vars => rt_data_write_vars
	<<RT data: sub interfaces>>=
	module subroutine rt_data_write_vars (object, unit, vars)
	class(rt_data_t), intent(in), target :: object
	integer, intent(in), optional :: unit
	type(string_t), dimension(:), intent(in) :: vars
	end subroutine rt_data_write_vars
	<<RT data: procedures>>=
	module subroutine rt_data_write_vars (object, unit, vars)
	class(rt_data_t), intent(in), target :: object
	integer, intent(in), optional :: unit
	type(string_t), dimension(:), intent(in) :: vars
	type(var_list_t), pointer :: var_list
	integer :: u, i
	u = given_output_unit (unit)
	var_list => object%get_var_list_ptr ()
	do i = 1, size (vars)
	associate (var => vars(i))
	if (var_list%contains (var, follow_link=.true.)) then
	call var_list%write_var (var, unit = u, &
	follow_link = .true., defined=.true.)
	end if
	end associate
	end do
	end subroutine rt_data_write_vars

	@ %def rt_data_write_vars
	@ Write only the model list.
	<<RT data: rt data: TBP>>=
	procedure :: write_model_list => rt_data_write_model_list
	<<RT data: sub interfaces>>=
	module subroutine rt_data_write_model_list (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine rt_data_write_model_list
	<<RT data: procedures>>=
	module subroutine rt_data_write_model_list (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call object%model_list%write (u)
	end subroutine rt_data_write_model_list

	@ %def rt_data_write_model_list
	@ Write only the library stack.
	<<RT data: rt data: TBP>>=
	procedure :: write_libraries => rt_data_write_libraries
	<<RT data: sub interfaces>>=
	module subroutine rt_data_write_libraries (object, unit, libpath)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: libpath
	end subroutine rt_data_write_libraries
	<<RT data: procedures>>=
	module subroutine rt_data_write_libraries (object, unit, libpath)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: libpath
	integer :: u
	u = given_output_unit (unit)
	call object%prclib_stack%write (u, libpath)
	end subroutine rt_data_write_libraries

	@ %def rt_data_write_libraries
	@ Write only the beam data.
	<<RT data: rt data: TBP>>=
	procedure :: write_beams => rt_data_write_beams
	<<RT data: sub interfaces>>=
	module subroutine rt_data_write_beams (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine rt_data_write_beams
	<<RT data: procedures>>=
	module subroutine rt_data_write_beams (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call object%beam_structure%write (u)
	call write_separator (u, 2)
	end subroutine rt_data_write_beams

	@ %def rt_data_write_beams
	@ Write only the process and event expressions.
	<<RT data: rt data: TBP>>=
	procedure :: write_expr => rt_data_write_expr
	<<RT data: sub interfaces>>=
	module subroutine rt_data_write_expr (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine rt_data_write_expr
	<<RT data: procedures>>=
	module subroutine rt_data_write_expr (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call object%pn%write (u)
	call write_separator (u, 2)
	end subroutine rt_data_write_expr

	@ %def rt_data_write_expr
	@ Write only the process stack.
	<<RT data: rt data: TBP>>=
	procedure :: write_process_stack => rt_data_write_process_stack
	<<RT data: sub interfaces>>=
	module subroutine rt_data_write_process_stack (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine rt_data_write_process_stack
	<<RT data: procedures>>=
	module subroutine rt_data_write_process_stack (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	call object%process_stack%write (unit)
	end subroutine rt_data_write_process_stack

	@ %def rt_data_write_process_stack
	@
	<<RT data: rt data: TBP>>=
	procedure :: write_var_descriptions => rt_data_write_var_descriptions
	<<RT data: sub interfaces>>=
	module subroutine rt_data_write_var_descriptions &
	(rt_data, unit, ascii_output)
	class(rt_data_t), intent(in) :: rt_data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: ascii_output
	end subroutine rt_data_write_var_descriptions
	<<RT data: procedures>>=
	module subroutine rt_data_write_var_descriptions (rt_data, unit, ascii_output)
	class(rt_data_t), intent(in) :: rt_data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: ascii_output
	integer :: u
	logical :: ao
	u = given_output_unit (unit)
	ao = .false.; if (present (ascii_output)) ao = ascii_output
	call rt_data%var_list%write (u, follow_link=.true., &
	descriptions=.true., ascii_output=ao)
	end subroutine rt_data_write_var_descriptions

	@ %def rt_data_write_var_descriptions
	@
	<<RT data: rt data: TBP>>=
	procedure :: show_description_of_string => rt_data_show_description_of_string
	<<RT data: sub interfaces>>=
	module subroutine rt_data_show_description_of_string (rt_data, string, &
	unit, ascii_output)
	class(rt_data_t), intent(in) :: rt_data
	type(string_t), intent(in) :: string
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: ascii_output
	end subroutine rt_data_show_description_of_string
	<<RT data: procedures>>=
	module subroutine rt_data_show_description_of_string (rt_data, string, &
	unit, ascii_output)
	class(rt_data_t), intent(in) :: rt_data
	type(string_t), intent(in) :: string
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: ascii_output
	integer :: u
	logical :: ao
	u = given_output_unit (unit)
	ao = .false.; if (present (ascii_output)) ao = ascii_output
	call rt_data%var_list%write_var (string, unit=u, follow_link=.true., &
	defined=.false., descriptions=.true., ascii_output=ao)
	end subroutine rt_data_show_description_of_string

	@ %def rt_data_show_description_of_string
	@
	\subsection{Clear}
	The [[clear]] command can remove the contents of various subobjects.
	The objects themselves should stay.
	<<RT data: rt data: TBP>>=
	procedure :: clear_beams => rt_data_clear_beams
	<<RT data: sub interfaces>>=
	module subroutine rt_data_clear_beams (global)
	class(rt_data_t), intent(inout) :: global
	end subroutine rt_data_clear_beams
	<<RT data: procedures>>=
	module subroutine rt_data_clear_beams (global)
	class(rt_data_t), intent(inout) :: global
	call global%beam_structure%final_sf ()
	call global%beam_structure%final_pol ()
	call global%beam_structure%final_mom ()
	end subroutine rt_data_clear_beams

	@ %def rt_data_clear_beams
	@
	\subsection{Initialization}
	Initialize runtime data. This defines special variables such as
	[[sqrts]], and should be done only for the instance that is actually
	global. Local copies will inherit the special variables.

	We link the global variable list to the process stack variable list,
	so the latter is always available (and kept global).
	<<RT data: rt data: TBP>>=
	procedure :: global_init => rt_data_global_init
	<<RT data: sub interfaces>>=
	module subroutine rt_data_global_init (global, paths, logfile)
	class(rt_data_t), intent(out), target :: global
	type(paths_t), intent(in), optional :: paths
	type(string_t), intent(in), optional :: logfile
	end subroutine rt_data_global_init
	<<RT data: procedures>>=
	module subroutine rt_data_global_init (global, paths, logfile)
	class(rt_data_t), intent(out), target :: global
	type(paths_t), intent(in), optional :: paths
	type(string_t), intent(in), optional :: logfile
	integer :: seed
	call global%os_data%init (paths)
	if (present (logfile)) then
	global%logfile = logfile
	else
	global%logfile = ""
	end if
	allocate (global%out_files)
	call system_clock (seed)
	call global%var_list%init_defaults (seed, paths)
	call global%init_pointer_variables ()
	call global%process_stack%init_var_list (global%var_list)
	end subroutine rt_data_global_init

	@ %def rt_data_global_init
	@
	\subsection{Local copies}
	This is done at compile time when a local copy of runtime data is
	needed: Link the variable list and initialize all derived parameters.
	This allows for synchronizing them with local variable changes without
	affecting global data.

	Also re-initialize pointer variables, so they point to local copies of
	their targets.
	<<RT data: rt data: TBP>>=
	procedure :: local_init => rt_data_local_init
	<<RT data: sub interfaces>>=
	module subroutine rt_data_local_init (local, global, env)
	class(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(in), target :: global
	integer, intent(in), optional :: env
	end subroutine rt_data_local_init
	<<RT data: procedures>>=
	module subroutine rt_data_local_init (local, global, env)
	class(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(in), target :: global
	integer, intent(in), optional :: env
	local%context => global
	call local%process_stack%link (global%process_stack)
	call local%process_stack%init_var_list (local%var_list)
	call local%process_stack%link_var_list (global%var_list)
	call local%var_list%append_string (var_str ("$model_name"), &
	var_str (""), intrinsic=.true.)
	call local%init_pointer_variables ()
	local%fallback_model => global%fallback_model
	local%os_data = global%os_data
	local%logfile = global%logfile
	call local%model_list%link (global%model_list)
	local%model => global%model
	if (associated (local%model)) then
	call local%model%link_var_list (local%var_list)
	end if
	if (allocated (global%event_callback)) then
	allocate (local%event_callback, source = global%event_callback)
	end if
	end subroutine rt_data_local_init

	@ %def rt_data_local_init
	@ These variables point to objects which get local copies:
	<<RT data: rt data: TBP>>=
	procedure :: init_pointer_variables => rt_data_init_pointer_variables
	<<RT data: sub interfaces>>=
	module subroutine rt_data_init_pointer_variables (local)
	class(rt_data_t), intent(inout), target :: local
	end subroutine rt_data_init_pointer_variables
	<<RT data: procedures>>=
	module subroutine rt_data_init_pointer_variables (local)
	class(rt_data_t), intent(inout), target :: local
	logical, target, save :: known = .true.
	call local%var_list%append_string_ptr (var_str ("$fc"), &
	local%os_data%fc, known, intrinsic=.true., &
	description=var_str('This string variable gives the ' // &
	'\ttt{Fortran} compiler used within \whizard. It can ' // &
	'only be accessed, not set by the user. (cf. also ' // &
	'\ttt{\$fcflags}, \ttt{\$fclibs})'))
	call local%var_list%append_string_ptr (var_str ("$fcflags"), &
	local%os_data%fcflags, known, intrinsic=.true., &
	description=var_str('This string variable gives the ' // &
	'compiler flags for the \ttt{Fortran} compiler used ' // &
	'within \whizard. It can only be accessed, not set by ' // &
	'the user. (cf. also \ttt{\$fc}, \ttt{\$fclibs})'))
	call local%var_list%append_string_ptr (var_str ("$fclibs"), &
	local%os_data%fclibs, known, intrinsic=.true., &
	description=var_str('This string variable gives the ' // &
	'linked libraries for the \ttt{Fortran} compiler used ' // &
	'within \whizard. It can only be accessed, not set by ' // &
	'the user. (cf. also \ttt{\$fc}, \ttt{\$fcflags})'))
	end subroutine rt_data_init_pointer_variables

	@ %def rt_data_init_pointer_variables
	@ This is done at execution time: Copy data, transfer pointers.
	[[local]] has intent(inout) because its local variable list has
	already been prepared by the previous routine.

	To be pedantic, the local pointers to model and library should point
	to the entries in the local copies. (However, as long as these are
	just shallow copies with identical content, this is actually
	irrelevant.)

	The process library and process stacks behave as global objects. The
	copies of the process library and process stacks should be shallow
	copies, so the contents stay identical. Since objects may be pushed
	on the stack in the local environment, upon restoring the global
	environment, we should reverse the assignment. Then the added stack
	elements will end up on the global stack. (This should be
	reconsidered in a parallel environment.)

	Gfortran 7/8/9 bug, has to remain in the main module:
	<<RT data: rt data: TBP>>=
	procedure :: activate => rt_data_activate
	<<RT data: main procedures>>=
	subroutine rt_data_activate (local)
	class(rt_data_t), intent(inout), target :: local
	class(rt_data_t), pointer :: global
	global => local%context
	if (associated (global)) then
	local%lexer => global%lexer
	call global%copy_globals (local)
	local%os_data = global%os_data
	local%logfile = global%logfile
	if (associated (global%prclib)) then
	local%prclib => &
	local%prclib_stack%get_library_ptr (global%prclib%get_name ())
	end if
	call local%import_values ()
	call local%process_stack%link (global%process_stack)
	local%it_list = global%it_list
	local%beam_structure = global%beam_structure
	local%pn = global%pn
	if (allocated (local%sample_fmt)) deallocate (local%sample_fmt)
	if (allocated (global%sample_fmt)) then
	allocate (local%sample_fmt (size (global%sample_fmt)), &
	source = global%sample_fmt)
	end if
	local%out_files => global%out_files
	local%model => global%model
	local%model_is_copy = .false.
	else if (.not. associated (local%model)) then
	local%model => local%preload_model
	local%model_is_copy = .false.
	end if
	if (associated (local%model)) then
	call local%model%link_var_list (local%var_list)
	call local%var_list%set_string (var_str ("$model_name"), &
	local%model%get_name (), is_known = .true.)
	else
	call local%var_list%set_string (var_str ("$model_name"), &
	var_str (""), is_known = .false.)
	end if
	end subroutine rt_data_activate

	@ %def rt_data_activate
	@ Restore the previous state of data, without actually finalizing the local
	environment. We also clear the local process stack. Some local modifications
	(model list and process library stack) are communicated to the global context,
	if there is any.

	If the [[keep_local]] flag is set, we want to retain current settings in
	the local environment. In particular, we create an instance of the currently
	selected model (which thus becomes separated from the model library!).
	The local variables are also kept.
	<<RT data: rt data: TBP>>=
	procedure :: deactivate => rt_data_deactivate
	<<RT data: sub interfaces>>=
	module subroutine rt_data_deactivate (local, global, keep_local)
	class(rt_data_t), intent(inout), target :: local
	class(rt_data_t), intent(inout), optional, target :: global
	logical, intent(in), optional :: keep_local
	end subroutine rt_data_deactivate
	<<RT data: procedures>>=
	module subroutine rt_data_deactivate (local, global, keep_local)
	class(rt_data_t), intent(inout), target :: local
	class(rt_data_t), intent(inout), optional, target :: global
	logical, intent(in), optional :: keep_local
	type(string_t) :: local_model, local_scheme
	logical :: same_model, delete
	delete = .true.; if (present (keep_local)) delete = .not. keep_local
	if (present (global)) then
	if (associated (global%model) .and. associated (local%model)) then
	local_model = local%model%get_name ()
	if (global%model%has_schemes ()) then
	local_scheme = local%model%get_scheme ()
	same_model = &
	global%model%matches (local_model, local_scheme)
	else
	same_model = global%model%matches (local_model)
	end if
	else
	same_model = .false.
	end if
	if (delete) then
	call local%process_stack%clear ()
	call local%unselect_model ()
	call local%unset_values ()
	else if (associated (local%model)) then
	call local%ensure_model_copy ()
	end if
	if (.not. same_model .and. associated (global%model)) then
	if (global%model%has_schemes ()) then
	call msg_message ("Restoring model '" // &
	char (global%model%get_name ()) // "', scheme '" // &
	char (global%model%get_scheme ()) // "'")
	else
	call msg_message ("Restoring model '" // &
	char (global%model%get_name ()) // "'")
	end if
	end if
	if (associated (global%model)) then
	call global%model%link_var_list (global%var_list)
	end if
	call global%restore_globals (local)
	else
	call local%unselect_model ()
	end if
	end subroutine rt_data_deactivate

	@ %def rt_data_deactivate
	@ This imports the global objects for which local modifications
	should be kept. Currently, this is only the process library stack.
	<<RT data: rt data: TBP>>=
	procedure :: copy_globals => rt_data_copy_globals
	<<RT data: sub interfaces>>=
	module subroutine rt_data_copy_globals (global, local)
	class(rt_data_t), intent(in) :: global
	class(rt_data_t), intent(inout) :: local
	end subroutine rt_data_copy_globals
	<<RT data: procedures>>=
	module subroutine rt_data_copy_globals (global, local)
	class(rt_data_t), intent(in) :: global
	class(rt_data_t), intent(inout) :: local
	local%prclib_stack = global%prclib_stack
	end subroutine rt_data_copy_globals

	@ %def rt_data_copy_globals
	@ This restores global objects for which local modifications
	should be kept. May also modify (remove) the local objects.
	<<RT data: rt data: TBP>>=
	procedure :: restore_globals => rt_data_restore_globals
	<<RT data: sub interfaces>>=
	module subroutine rt_data_restore_globals (global, local)
	class(rt_data_t), intent(inout) :: global
	class(rt_data_t), intent(inout) :: local
	end subroutine rt_data_restore_globals
	<<RT data: procedures>>=
	module subroutine rt_data_restore_globals (global, local)
	class(rt_data_t), intent(inout) :: global
	class(rt_data_t), intent(inout) :: local
	global%prclib_stack = local%prclib_stack
	call local%handle_exports (global)
	end subroutine rt_data_restore_globals

	@ %def rt_data_restore_globals
	@
	\subsection{Exported objects}
	Exported objects are transferred to the global state when a local environment
	is closed. (For the top-level global data set, there is no effect.)

	The current implementation handles only the [[results]] object, which resolves
	to the local process stack. The stack elements are appended to the global
	stack without modification, the local stack becomes empty.

	Write names of objects to be exported:
	<<RT data: rt data: TBP>>=
	procedure :: write_exports => rt_data_write_exports
	<<RT data: sub interfaces>>=
	module subroutine rt_data_write_exports (rt_data, unit)
	class(rt_data_t), intent(in) :: rt_data
	integer, intent(in), optional :: unit
	end subroutine rt_data_write_exports
	<<RT data: procedures>>=
	module subroutine rt_data_write_exports (rt_data, unit)
	class(rt_data_t), intent(in) :: rt_data
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	do i = 1, rt_data%get_n_export ()
	write (u, "(A)") char (rt_data%export(i))
	end do
	end subroutine rt_data_write_exports

	@ %def rt_data_write_exports
	@ The number of entries in the export list.
	<<RT data: rt data: TBP>>=
	procedure :: get_n_export => rt_data_get_n_export
	<<RT data: sub interfaces>>=
	module function rt_data_get_n_export (rt_data) result (n)
	class(rt_data_t), intent(in) :: rt_data
	integer :: n
	end function rt_data_get_n_export
	<<RT data: procedures>>=
	module function rt_data_get_n_export (rt_data) result (n)
	class(rt_data_t), intent(in) :: rt_data
	integer :: n
	if (allocated (rt_data%export)) then
	n = size (rt_data%export)
	else
	n = 0
	end if
	end function rt_data_get_n_export

	@ %def rt_data_get_n_export
	@ Return a specific export
	@ Append new names to the export list. If a duplicate occurs, do not transfer
	it.
	<<RT data: rt data: TBP>>=
	procedure :: append_exports => rt_data_append_exports
	<<RT data: sub interfaces>>=
	module subroutine rt_data_append_exports (rt_data, export)
	class(rt_data_t), intent(inout) :: rt_data
	type(string_t), dimension(:), intent(in) :: export
	end subroutine rt_data_append_exports
	<<RT data: procedures>>=
	module subroutine rt_data_append_exports (rt_data, export)
	class(rt_data_t), intent(inout) :: rt_data
	type(string_t), dimension(:), intent(in) :: export
	logical, dimension(:), allocatable :: mask
	type(string_t), dimension(:), allocatable :: tmp
	integer :: i, j, n
	if (.not. allocated (rt_data%export)) allocate (rt_data%export (0))
	n = size (rt_data%export)
	allocate (mask (size (export)), source=.false.)
	do i = 1, size (export)
	mask(i) = all (export(i) /= rt_data%export) &
	.and. all (export(i) /= export(:i-1))
	end do
	if (count (mask) > 0) then
	allocate (tmp (n + count (mask)))
	tmp(1:n) = rt_data%export(:)
	j = n
	do i = 1, size (export)
	if (mask(i)) then
	j = j + 1
	tmp(j) = export(i)
	end if
	end do
	call move_alloc (from=tmp, to=rt_data%export)
	end if
	end subroutine rt_data_append_exports

	@ %def rt_data_append_exports
	@ Transfer export-objects from the [[local]] rt data to the [[global]] rt
	data, as far as supported.
	<<RT data: rt data: TBP>>=
	procedure :: handle_exports => rt_data_handle_exports
	<<RT data: sub interfaces>>=
	module subroutine rt_data_handle_exports (local, global)
	class(rt_data_t), intent(inout), target :: local
	class(rt_data_t), intent(inout), target :: global
	end subroutine rt_data_handle_exports
	<<RT data: procedures>>=
	module subroutine rt_data_handle_exports (local, global)
	class(rt_data_t), intent(inout), target :: local
	class(rt_data_t), intent(inout), target :: global
	type(string_t) :: export
	integer :: i
	if (local%get_n_export () > 0) then
	do i = 1, local%get_n_export ()
	export = local%export(i)
	select case (char (export))
	case ("results")
	call msg_message ("Exporting integration results &
	&to outer environment")
	call local%transfer_process_stack (global)
	case default
	call msg_bug ("handle exports: '" &
	// char (export) // "' unsupported")
	end select
	end do
	end if
	end subroutine rt_data_handle_exports

	@ %def rt_data_handle_exports
	@ Export the process stack. One-by-one, take the last process from the local
	stack and push it on the global stack. Also handle the corresponding result
	variables: append if the process did not exist yet in the global stack,
	otherwise update.

	TODO: result variables do not work that way yet, require initialization in the
	global variable list.
	<<RT data: rt data: TBP>>=
	procedure :: transfer_process_stack => rt_data_transfer_process_stack
	<<RT data: sub interfaces>>=
	module subroutine rt_data_transfer_process_stack (local, global)
	class(rt_data_t), intent(inout), target :: local
	class(rt_data_t), intent(inout), target :: global
	end subroutine rt_data_transfer_process_stack
	<<RT data: procedures>>=
	module subroutine rt_data_transfer_process_stack (local, global)
	class(rt_data_t), intent(inout), target :: local
	class(rt_data_t), intent(inout), target :: global
	type(process_entry_t), pointer :: process
	type(string_t) :: process_id
	do
	call local%process_stack%pop_last (process)
	if (.not. associated (process)) exit
	process_id = process%get_id ()
	call global%process_stack%push (process)
	call global%process_stack%fill_result_vars (process_id)
	call global%process_stack%update_result_vars &
	(process_id, global%var_list)
	end do
	end subroutine rt_data_transfer_process_stack

	@ %def rt_data_transfer_process_stack
	@
	\subsection{Finalization}
	Finalizer for the variable list and the structure-function list.
	This is done only for the global RT dataset; local copies contain
	pointers to this and do not need a finalizer.
	<<RT data: rt data: TBP>>=
	procedure :: final => rt_data_global_final
	<<RT data: sub interfaces>>=
	module subroutine rt_data_global_final (global)
	class(rt_data_t), intent(inout) :: global
	end subroutine rt_data_global_final
	<<RT data: procedures>>=
	module subroutine rt_data_global_final (global)
	class(rt_data_t), intent(inout) :: global
	call global%process_stack%final ()
	call global%prclib_stack%final ()
	call global%model_list%final ()
	call global%var_list%final (follow_link=.false.)
	if (associated (global%out_files)) then
	call file_list_final (global%out_files)
	deallocate (global%out_files)
	end if
	end subroutine rt_data_global_final

	@ %def rt_data_global_final
	@ The local copy needs a finalizer for the variable list, which consists
	of local copies. This finalizer is called only when the local
	environment is finally discarded. (Note that the process stack should
	already have been cleared after execution, which can occur many times
	for the same local environment.)
	<<RT data: rt data: TBP>>=
	procedure :: local_final => rt_data_local_final
	<<RT data: sub interfaces>>=
	module subroutine rt_data_local_final (local)
	class(rt_data_t), intent(inout) :: local
	end subroutine rt_data_local_final
	<<RT data: procedures>>=
	module subroutine rt_data_local_final (local)
	class(rt_data_t), intent(inout) :: local
	call local%process_stack%clear ()
	call local%model_list%final ()
	call local%var_list%final (follow_link=.false.)
	end subroutine rt_data_local_final

	@ %def rt_data_local_final
	@
	\subsection{Model Management}
	Read a model, so it becomes available for activation. No variables or model
	copies, this is just initialization.

	If this is a local environment, the model will be automatically read into the
	global context.
	<<RT data: rt data: TBP>>=
	procedure :: read_model => rt_data_read_model
	<<RT data: sub interfaces>>=
	module subroutine rt_data_read_model (global, name, model, scheme)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	type(model_t), pointer, intent(out) :: model
	end subroutine rt_data_read_model
	<<RT data: procedures>>=
	module subroutine rt_data_read_model (global, name, model, scheme)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	type(model_t), pointer, intent(out) :: model
	type(string_t) :: filename
	filename = name // ".mdl"
	call global%model_list%read_model &
	(name, filename, global%os_data, model, scheme)
	end subroutine rt_data_read_model

	@ %def rt_data_read_model
	@ Read a UFO model. Create it on the fly if necessary.
	<<RT data: rt data: TBP>>=
	procedure :: read_ufo_model => rt_data_read_ufo_model
	<<RT data: sub interfaces>>=
	module subroutine rt_data_read_ufo_model (global, name, model, ufo_path)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(model_t), pointer, intent(out) :: model
	type(string_t), intent(in), optional :: ufo_path
	end subroutine rt_data_read_ufo_model
	<<RT data: procedures>>=
	module subroutine rt_data_read_ufo_model (global, name, model, ufo_path)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(model_t), pointer, intent(out) :: model
	type(string_t), intent(in), optional :: ufo_path
	type(string_t) :: filename
	filename = name // ".ufo.mdl"
	call global%model_list%read_model &
	(name, filename, global%os_data, model, ufo=.true., ufo_path=ufo_path)
	end subroutine rt_data_read_ufo_model

	@ %def rt_data_read_ufo_model
	@ Initialize the fallback model. This model is used
	whenever the current model does not describe all physical particles
	(hadrons, mainly). It is not supposed to be modified, and the pointer
	should remain linked to this model.
	<<RT data: rt data: TBP>>=
	procedure :: init_fallback_model => rt_data_init_fallback_model
	<<RT data: sub interfaces>>=
	module subroutine rt_data_init_fallback_model (global, name, filename)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name, filename
	end subroutine rt_data_init_fallback_model
	<<RT data: procedures>>=
	module subroutine rt_data_init_fallback_model (global, name, filename)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name, filename
	call global%model_list%read_model &
	(name, filename, global%os_data, global%fallback_model)
	end subroutine rt_data_init_fallback_model

	@ %def rt_data_init_fallback_model
	@
	Activate a model: assign the current-model pointer and set the model name in
	the variable list. If necessary, read the model from file. Link the global
	variable list to the model variable list.
	<<RT data: rt data: TBP>>=
	procedure :: select_model => rt_data_select_model
	<<RT data: sub interfaces>>=
	module subroutine rt_data_select_model (global, name, scheme, ufo, ufo_path)
	class(rt_data_t), intent(inout), target :: global
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	end subroutine rt_data_select_model
	<<RT data: procedures>>=
	module subroutine rt_data_select_model (global, name, scheme, ufo, ufo_path)
	class(rt_data_t), intent(inout), target :: global
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	logical :: same_model, ufo_model
	ufo_model = .false.; if (present (ufo)) ufo_model = ufo
	if (associated (global%model)) then
	same_model = global%model%matches (name, scheme, ufo)
	else
	same_model = .false.
	end if
	if (.not. same_model) then
	global%model => global%model_list%get_model_ptr (name, scheme, ufo)
	if (.not. associated (global%model)) then
	if (ufo_model) then
	call global%read_ufo_model (name, global%model, ufo_path)
	else
	call global%read_model (name, global%model)
	end if
	global%model_is_copy = .false.
	else if (associated (global%context)) then
	global%model_is_copy = &
	global%model_list%model_exists (name, scheme, ufo, &
	follow_link=.false.)
	else
	global%model_is_copy = .false.
	end if
	end if
	if (associated (global%model)) then
	call global%model%link_var_list (global%var_list)
	call global%var_list%set_string (var_str ("$model_name"), &
	name, is_known = .true.)
	if (global%model%is_ufo_model ()) then
	call msg_message ("Switching to model '" // char (name) // "' " &
	// "(generated from UFO source)")
	else if (global%model%has_schemes ()) then
	call msg_message ("Switching to model '" // char (name) // "', " &
	// "scheme '" // char (global%model%get_scheme ()) // "'")
	else
	call msg_message ("Switching to model '" // char (name) // "'")
	end if
	else
	call global%var_list%set_string (var_str ("$model_name"), &
	var_str (""), is_known = .false.)
	end if
	end subroutine rt_data_select_model

	@ %def rt_data_select_model
	@
	Remove the model link. Do not unset the model name variable, because
	this may unset the variable in a parent [[rt_data]] object (via linked
	var lists).
	<<RT data: rt data: TBP>>=
	procedure :: unselect_model => rt_data_unselect_model
	<<RT data: sub interfaces>>=
	module subroutine rt_data_unselect_model (global)
	class(rt_data_t), intent(inout), target :: global
	end subroutine rt_data_unselect_model
	<<RT data: procedures>>=
	module subroutine rt_data_unselect_model (global)
	class(rt_data_t), intent(inout), target :: global
	if (associated (global%model)) then
	global%model => null ()
	global%model_is_copy = .false.
	end if
	end subroutine rt_data_unselect_model

	@ %def rt_data_unselect_model
	@
	Create a copy of the currently selected model and append it to the local model
	list. The model pointer is redirected to the copy.
	(Not applicable for the global model list, those models will be
	modified in-place.)
	<<RT data: rt data: TBP>>=
	procedure :: ensure_model_copy => rt_data_ensure_model_copy
	<<RT data: sub interfaces>>=
	module subroutine rt_data_ensure_model_copy (global)
	class(rt_data_t), intent(inout), target :: global
	end subroutine rt_data_ensure_model_copy
	<<RT data: procedures>>=
	module subroutine rt_data_ensure_model_copy (global)
	class(rt_data_t), intent(inout), target :: global
	if (associated (global%context)) then
	if (.not. global%model_is_copy) then
	call global%model_list%append_copy (global%model, global%model)
	global%model_is_copy = .true.
	call global%model%link_var_list (global%var_list)
	end if
	end if
	end subroutine rt_data_ensure_model_copy

	@ %def rt_data_ensure_model_copy
	@
	Modify a model variable. The update mechanism will ensure that the model
	parameter set remains consistent. This has to take place in a local copy
	of the current model. If there is none yet, create one.
	<<RT data: rt data: TBP>>=
	procedure :: model_set_real => rt_data_model_set_real
	<<RT data: sub interfaces>>=
	module subroutine rt_data_model_set_real &
	(global, name, rval, verbose, pacified)
	class(rt_data_t), intent(inout), target :: global
	type(string_t), intent(in) :: name
	real(default), intent(in) :: rval
	logical, intent(in), optional :: verbose, pacified
	end subroutine rt_data_model_set_real
	<<RT data: procedures>>=
	module subroutine rt_data_model_set_real &
	(global, name, rval, verbose, pacified)
	class(rt_data_t), intent(inout), target :: global
	type(string_t), intent(in) :: name
	real(default), intent(in) :: rval
	logical, intent(in), optional :: verbose, pacified
	call global%ensure_model_copy ()
	call global%model%set_real (name, rval, verbose, pacified)
	end subroutine rt_data_model_set_real

	@ %def rt_data_model_set_real
	@
	Modify particle properties. This has to take place in a local copy
	of the current model. If there is none yet, create one.
	<<RT data: rt data: TBP>>=
	procedure :: modify_particle => rt_data_modify_particle
	<<RT data: sub interfaces>>=
	module subroutine rt_data_modify_particle &
	(global, pdg, polarized, stable, decay, &
	isotropic_decay, diagonal_decay, decay_helicity)
	class(rt_data_t), intent(inout), target :: global
	integer, intent(in) :: pdg
	logical, intent(in), optional :: polarized, stable
	logical, intent(in), optional :: isotropic_decay, diagonal_decay
	integer, intent(in), optional :: decay_helicity
	type(string_t), dimension(:), intent(in), optional :: decay
	end subroutine rt_data_modify_particle
	<<RT data: procedures>>=
	module subroutine rt_data_modify_particle &
	(global, pdg, polarized, stable, decay, &
	isotropic_decay, diagonal_decay, decay_helicity)
	class(rt_data_t), intent(inout), target :: global
	integer, intent(in) :: pdg
	logical, intent(in), optional :: polarized, stable
	logical, intent(in), optional :: isotropic_decay, diagonal_decay
	integer, intent(in), optional :: decay_helicity
	type(string_t), dimension(:), intent(in), optional :: decay
	call global%ensure_model_copy ()
	if (present (polarized)) then
	if (polarized) then
	call global%model%set_polarized (pdg)
	else
	call global%model%set_unpolarized (pdg)
	end if
	end if
	if (present (stable)) then
	if (stable) then
	call global%model%set_stable (pdg)
	else if (present (decay)) then
	call global%model%set_unstable &
	(pdg, decay, isotropic_decay, diagonal_decay, decay_helicity)
	else
	call msg_bug ("Setting particle unstable: missing decay processes")
	end if
	end if
	end subroutine rt_data_modify_particle

	@ %def rt_data_modify_particle
	@
	\subsection{Managing Variables}
	Return a pointer to the currently active variable list. If there is no model,
	this is the global variable list. If there is one, it is the model variable
	list, which should be linked to the former.
	<<RT data: rt data: TBP>>=
	procedure :: get_var_list_ptr => rt_data_get_var_list_ptr
	<<RT data: sub interfaces>>=
	module function rt_data_get_var_list_ptr (global) result (var_list)
	class(rt_data_t), intent(in), target :: global
	type(var_list_t), pointer :: var_list
	end function rt_data_get_var_list_ptr
	<<RT data: procedures>>=
	module function rt_data_get_var_list_ptr (global) result (var_list)
	class(rt_data_t), intent(in), target :: global
	type(var_list_t), pointer :: var_list
	if (associated (global%model)) then
	var_list => global%model%get_var_list_ptr ()
	else
	var_list => global%var_list
	end if
	end function rt_data_get_var_list_ptr

	@ %def rt_data_get_var_list_ptr
	@ Initialize a local variable: append it to the current variable list. No
	initial value, yet.
	<<RT data: rt data: TBP>>=
	procedure :: append_log => rt_data_append_log
	procedure :: append_int => rt_data_append_int
	procedure :: append_real => rt_data_append_real
	procedure :: append_cmplx => rt_data_append_cmplx
	procedure :: append_subevt => rt_data_append_subevt
	procedure :: append_pdg_array => rt_data_append_pdg_array
	procedure :: append_string => rt_data_append_string
	<<RT data: sub interfaces>>=
	module subroutine rt_data_append_log (local, name, lval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: lval
	logical, intent(in), optional :: intrinsic, user
	end subroutine rt_data_append_log
	module subroutine rt_data_append_int (local, name, ival, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: ival
	logical, intent(in), optional :: intrinsic, user
	end subroutine rt_data_append_int
	module subroutine rt_data_append_real (local, name, rval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	real(default), intent(in), optional :: rval
	logical, intent(in), optional :: intrinsic, user
	end subroutine rt_data_append_real
	module subroutine rt_data_append_cmplx (local, name, cval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	complex(default), intent(in), optional :: cval
	logical, intent(in), optional :: intrinsic, user
	end subroutine rt_data_append_cmplx
	module subroutine rt_data_append_subevt (local, name, pval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in), optional :: pval
	logical, intent(in) :: intrinsic, user
	end subroutine rt_data_append_subevt
	module subroutine rt_data_append_pdg_array &
	(local, name, aval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in), optional :: aval
	logical, intent(in), optional :: intrinsic, user
	end subroutine rt_data_append_pdg_array
	module subroutine rt_data_append_string (local, name, sval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: sval
	logical, intent(in), optional :: intrinsic, user
	end subroutine rt_data_append_string
	<<RT data: procedures>>=
	module subroutine rt_data_append_log (local, name, lval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: lval
	logical, intent(in), optional :: intrinsic, user
	call local%var_list%append_log (name, lval, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_log

	module subroutine rt_data_append_int (local, name, ival, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: ival
	logical, intent(in), optional :: intrinsic, user
	call local%var_list%append_int (name, ival, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_int

	module subroutine rt_data_append_real (local, name, rval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	real(default), intent(in), optional :: rval
	logical, intent(in), optional :: intrinsic, user
	call local%var_list%append_real (name, rval, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_real

	module subroutine rt_data_append_cmplx (local, name, cval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	complex(default), intent(in), optional :: cval
	logical, intent(in), optional :: intrinsic, user
	call local%var_list%append_cmplx (name, cval, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_cmplx

	module subroutine rt_data_append_subevt (local, name, pval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in), optional :: pval
	logical, intent(in) :: intrinsic, user
	call local%var_list%append_subevt (name, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_subevt

	module subroutine rt_data_append_pdg_array &
	(local, name, aval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in), optional :: aval
	logical, intent(in), optional :: intrinsic, user
	call local%var_list%append_pdg_array (name, aval, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_pdg_array

	module subroutine rt_data_append_string (local, name, sval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: sval
	logical, intent(in), optional :: intrinsic, user
	call local%var_list%append_string (name, sval, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_string

	@ %def rt_data_append_log
	@ %def rt_data_append_int
	@ %def rt_data_append_real
	@ %def rt_data_append_cmplx
	@ %def rt_data_append_subevt
	@ %def rt_data_append_pdg_array
	@ %def rt_data_append_string
	@ Import values for all local variables, given a global context environment
	where these variables are defined.
	<<RT data: rt data: TBP>>=
	procedure :: import_values => rt_data_import_values
	<<RT data: sub interfaces>>=
	module subroutine rt_data_import_values (local)
	class(rt_data_t), intent(inout) :: local
	end subroutine rt_data_import_values
	<<RT data: procedures>>=
	module subroutine rt_data_import_values (local)
	class(rt_data_t), intent(inout) :: local
	type(rt_data_t), pointer :: global
	global => local%context
	if (associated (global)) then
	call local%var_list%import (global%var_list)
	end if
	end subroutine rt_data_import_values

	@ %def rt_data_import_values
	@ Unset all variable values.
	<<RT data: rt data: TBP>>=
	procedure :: unset_values => rt_data_unset_values
	<<RT data: sub interfaces>>=
	module subroutine rt_data_unset_values (global)
	class(rt_data_t), intent(inout) :: global
	end subroutine rt_data_unset_values
	<<RT data: procedures>>=
	module subroutine rt_data_unset_values (global)
	class(rt_data_t), intent(inout) :: global
	call global%var_list%undefine (follow_link=.false.)
	end subroutine rt_data_unset_values

	@ %def rt_data_unset_values
	@ Set a variable. (Not a model variable, these are handled separately.) We
	can assume that the variable has been initialized.
	<<RT data: rt data: TBP>>=
	procedure :: set_log => rt_data_set_log
	procedure :: set_int => rt_data_set_int
	procedure :: set_real => rt_data_set_real
	procedure :: set_cmplx => rt_data_set_cmplx
	procedure :: set_subevt => rt_data_set_subevt
	procedure :: set_pdg_array => rt_data_set_pdg_array
	procedure :: set_string => rt_data_set_string
	<<RT data: sub interfaces>>=
	module subroutine rt_data_set_log &
	(global, name, lval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	logical, intent(in) :: lval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	end subroutine rt_data_set_log
	module subroutine rt_data_set_int &
	(global, name, ival, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	integer, intent(in) :: ival
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	end subroutine rt_data_set_int
	module subroutine rt_data_set_real &
	(global, name, rval, is_known, force, verbose, pacified)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	real(default), intent(in) :: rval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose, pacified
	end subroutine rt_data_set_real
	module subroutine rt_data_set_cmplx &
	(global, name, cval, is_known, force, verbose, pacified)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: cval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose, pacified
	end subroutine rt_data_set_cmplx
	module subroutine rt_data_set_subevt &
	(global, name, pval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in) :: pval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	end subroutine rt_data_set_subevt
	module subroutine rt_data_set_pdg_array &
	(global, name, aval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in) :: aval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	end subroutine rt_data_set_pdg_array
	module subroutine rt_data_set_string &
	(global, name, sval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: sval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	end subroutine rt_data_set_string
	<<RT data: procedures>>=
	module subroutine rt_data_set_log &
	(global, name, lval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	logical, intent(in) :: lval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	call global%var_list%set_log (name, lval, is_known, &
	force=force, verbose=verbose)
	end subroutine rt_data_set_log

	module subroutine rt_data_set_int &
	(global, name, ival, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	integer, intent(in) :: ival
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	call global%var_list%set_int (name, ival, is_known, &
	force=force, verbose=verbose)
	end subroutine rt_data_set_int

	module subroutine rt_data_set_real &
	(global, name, rval, is_known, force, verbose, pacified)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	real(default), intent(in) :: rval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose, pacified
	call global%var_list%set_real (name, rval, is_known, &
	force=force, verbose=verbose, pacified=pacified)
	end subroutine rt_data_set_real

	module subroutine rt_data_set_cmplx &
	(global, name, cval, is_known, force, verbose, pacified)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: cval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose, pacified
	call global%var_list%set_cmplx (name, cval, is_known, &
	force=force, verbose=verbose, pacified=pacified)
	end subroutine rt_data_set_cmplx

	module subroutine rt_data_set_subevt &
	(global, name, pval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in) :: pval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	call global%var_list%set_subevt (name, pval, is_known, &
	force=force, verbose=verbose)
	end subroutine rt_data_set_subevt

	module subroutine rt_data_set_pdg_array &
	(global, name, aval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in) :: aval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	call global%var_list%set_pdg_array (name, aval, is_known, &
	force=force, verbose=verbose)
	end subroutine rt_data_set_pdg_array

	module subroutine rt_data_set_string &
	(global, name, sval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: sval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	call global%var_list%set_string (name, sval, is_known, &
	force=force, verbose=verbose)
	end subroutine rt_data_set_string

	@ %def rt_data_set_log
	@ %def rt_data_set_int
	@ %def rt_data_set_real
	@ %def rt_data_set_cmplx
	@ %def rt_data_set_subevt
	@ %def rt_data_set_pdg_array
	@ %def rt_data_set_string
	@ Return the value of a variable, assuming that the type is correct.
	<<RT data: rt data: TBP>>=
	procedure :: get_lval => rt_data_get_lval
	procedure :: get_ival => rt_data_get_ival
	procedure :: get_rval => rt_data_get_rval
	procedure :: get_cval => rt_data_get_cval
	procedure :: get_pval => rt_data_get_pval
	procedure :: get_aval => rt_data_get_aval
	procedure :: get_sval => rt_data_get_sval
	<<RT data: sub interfaces>>=
	module function rt_data_get_lval (global, name) result (lval)
	logical :: lval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	end function rt_data_get_lval
	module function rt_data_get_ival (global, name) result (ival)
	integer :: ival
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	end function rt_data_get_ival
	module function rt_data_get_rval (global, name) result (rval)
	real(default) :: rval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	end function rt_data_get_rval
	module function rt_data_get_cval (global, name) result (cval)
	complex(default) :: cval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	end function rt_data_get_cval
	module function rt_data_get_aval (global, name) result (aval)
	type(pdg_array_t) :: aval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	end function rt_data_get_aval
	module function rt_data_get_pval (global, name) result (pval)
	type(subevt_t) :: pval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	end function rt_data_get_pval
	module function rt_data_get_sval (global, name) result (sval)
	type(string_t) :: sval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	end function rt_data_get_sval
	<<RT data: procedures>>=
	module function rt_data_get_lval (global, name) result (lval)
	logical :: lval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	lval = var_list%get_lval (name)
	end function rt_data_get_lval

	module function rt_data_get_ival (global, name) result (ival)
	integer :: ival
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	ival = var_list%get_ival (name)
	end function rt_data_get_ival

	module function rt_data_get_rval (global, name) result (rval)
	real(default) :: rval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	rval = var_list%get_rval (name)
	end function rt_data_get_rval

	module function rt_data_get_cval (global, name) result (cval)
	complex(default) :: cval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	cval = var_list%get_cval (name)
	end function rt_data_get_cval

	module function rt_data_get_aval (global, name) result (aval)
	type(pdg_array_t) :: aval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	aval = var_list%get_aval (name)
	end function rt_data_get_aval

	module function rt_data_get_pval (global, name) result (pval)
	type(subevt_t) :: pval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	pval = var_list%get_pval (name)
	end function rt_data_get_pval

	module function rt_data_get_sval (global, name) result (sval)
	type(string_t) :: sval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	sval = var_list%get_sval (name)
	end function rt_data_get_sval

	@ %def rt_data_get_lval
	@ %def rt_data_get_ival
	@ %def rt_data_get_rval
	@ %def rt_data_get_cval
	@ %def rt_data_get_pval
	@ %def rt_data_get_aval
	@ %def rt_data_get_sval
	@ Return true if the variable exists in the global list.
	<<RT data: rt data: TBP>>=
	procedure :: contains => rt_data_contains
	<<RT data: sub interfaces>>=
	module function rt_data_contains (global, name) result (lval)
	logical :: lval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	end function rt_data_contains
	<<RT data: procedures>>=
	module function rt_data_contains (global, name) result (lval)
	logical :: lval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	lval = var_list%contains (name)
	end function rt_data_contains

	@ %def rt_data_contains
	@ Return true if the value of the variable is known.
	<<RT data: rt data: TBP>>=
	procedure :: is_known => rt_data_is_known
	<<RT data: sub interfaces>>=
	module function rt_data_is_known (global, name) result (lval)
	logical :: lval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	end function rt_data_is_known
	<<RT data: procedures>>=
	module function rt_data_is_known (global, name) result (lval)
	logical :: lval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	lval = var_list%is_known (name)
	end function rt_data_is_known

	@ %def rt_data_is_known
	@
	\subsection{Further Content}
	Add a library (available via a pointer of type [[prclib_entry_t]]) to
	the stack and update the pointer and variable list to the current
	library. The pointer association of [[prclib_entry]] will be discarded.
	<<RT data: rt data: TBP>>=
	procedure :: add_prclib => rt_data_add_prclib
	<<RT data: sub interfaces>>=
	module subroutine rt_data_add_prclib (global, prclib_entry)
	class(rt_data_t), intent(inout) :: global
	type(prclib_entry_t), intent(inout), pointer :: prclib_entry
	end subroutine rt_data_add_prclib
	<<RT data: procedures>>=
	module subroutine rt_data_add_prclib (global, prclib_entry)
	class(rt_data_t), intent(inout) :: global
	type(prclib_entry_t), intent(inout), pointer :: prclib_entry
	call global%prclib_stack%push (prclib_entry)
	call global%update_prclib (global%prclib_stack%get_first_ptr ())
	end subroutine rt_data_add_prclib

	@ %def rt_data_add_prclib
	@ Given a pointer to a process library, make this the currently active
	library.
	<<RT data: rt data: TBP>>=
	procedure :: update_prclib => rt_data_update_prclib
	<<RT data: sub interfaces>>=
	module subroutine rt_data_update_prclib (global, lib)
	class(rt_data_t), intent(inout) :: global
	type(process_library_t), intent(in), target :: lib
	end subroutine rt_data_update_prclib
	<<RT data: procedures>>=
	module subroutine rt_data_update_prclib (global, lib)
	class(rt_data_t), intent(inout) :: global
	type(process_library_t), intent(in), target :: lib
	global%prclib => lib
	if (global%var_list%contains (&
	var_str ("$library_name"), follow_link = .false.)) then
	call global%var_list%set_string (var_str ("$library_name"), &
	global%prclib%get_name (), is_known=.true.)
	else
	call global%var_list%append_string ( &
	var_str ("$library_name"), global%prclib%get_name (), &
	intrinsic = .true.)
	end if
	end subroutine rt_data_update_prclib

	@ %def rt_data_update_prclib
	@
	\subsection{Miscellaneous}
	The helicity selection data are distributed among several parameters. Here,
	we collect them in a single record.
	<<RT data: rt data: TBP>>=
	procedure :: get_helicity_selection => rt_data_get_helicity_selection
	<<RT data: sub interfaces>>=
	module function rt_data_get_helicity_selection &
	(rt_data) result (helicity_selection)
	class(rt_data_t), intent(in) :: rt_data
	type(helicity_selection_t) :: helicity_selection
	end function rt_data_get_helicity_selection
	<<RT data: procedures>>=
	module function rt_data_get_helicity_selection &
	(rt_data) result (helicity_selection)
	class(rt_data_t), intent(in) :: rt_data
	type(helicity_selection_t) :: helicity_selection
	associate (var_list => rt_data%var_list)
	helicity_selection%active = var_list%get_lval (&
	var_str ("?helicity_selection_active"))
	if (helicity_selection%active) then
	helicity_selection%threshold = var_list%get_rval (&
	var_str ("helicity_selection_threshold"))
	helicity_selection%cutoff = var_list%get_ival (&
	var_str ("helicity_selection_cutoff"))
	end if
	end associate
	end function rt_data_get_helicity_selection

	@ %def rt_data_get_helicity_selection
	@ Show the beam setup: beam structure and relevant global variables.
	<<RT data: rt data: TBP>>=
	procedure :: show_beams => rt_data_show_beams
	<<RT data: sub interfaces>>=
	module subroutine rt_data_show_beams (rt_data, unit)
	class(rt_data_t), intent(in) :: rt_data
	integer, intent(in), optional :: unit
	end subroutine rt_data_show_beams
	<<RT data: procedures>>=
	module subroutine rt_data_show_beams (rt_data, unit)
	class(rt_data_t), intent(in) :: rt_data
	integer, intent(in), optional :: unit
	type(string_t) :: s
	integer :: u
	u = given_output_unit (unit)
	associate (beams => rt_data%beam_structure, var_list => rt_data%var_list)
	call beams%write (u)
	if (.not. beams%asymmetric () .and. beams%get_n_beam () == 2) then
	write (u, "(2x,A," // FMT_19 // ",1x,'GeV')") "sqrts =", &
	var_list%get_rval (var_str ("sqrts"))
	end if
	if (beams%contains ("pdf_builtin")) then
	s = var_list%get_sval (var_str ("$pdf_builtin_set"))
	if (s /= "") then
	write (u, "(2x,A,1x,3A)") "PDF set =", '"', char (s), '"'
	else
	write (u, "(2x,A,1x,A)") "PDF set =", "[undefined]"
	end if
	end if
	if (beams%contains ("lhapdf")) then
	s = var_list%get_sval (var_str ("$lhapdf_dir"))
	if (s /= "") then
	write (u, "(2x,A,1x,3A)") "LHAPDF dir =", '"', char (s), '"'
	end if
	s = var_list%get_sval (var_str ("$lhapdf_file"))
	if (s /= "") then
	write (u, "(2x,A,1x,3A)") "LHAPDF file =", '"', char (s), '"'
	write (u, "(2x,A,1x,I0)") "LHAPDF member =", &
	var_list%get_ival (var_str ("lhapdf_member"))
	else
	write (u, "(2x,A,1x,A)") "LHAPDF file =", "[undefined]"
	end if
	end if
	if (beams%contains ("lhapdf_photon")) then
	s = var_list%get_sval (var_str ("$lhapdf_dir"))
	if (s /= "") then
	write (u, "(2x,A,1x,3A)") "LHAPDF dir =", '"', char (s), '"'
	end if
	s = var_list%get_sval (var_str ("$lhapdf_photon_file"))
	if (s /= "") then
	write (u, "(2x,A,1x,3A)") "LHAPDF file =", '"', char (s), '"'
	write (u, "(2x,A,1x,I0)") "LHAPDF member =", &
	var_list%get_ival (var_str ("lhapdf_member"))
	write (u, "(2x,A,1x,I0)") "LHAPDF scheme =", &
	var_list%get_ival (&
	var_str ("lhapdf_photon_scheme"))
	else
	write (u, "(2x,A,1x,A)") "LHAPDF file =", "[undefined]"
	end if
	end if
	if (beams%contains ("isr")) then
	write (u, "(2x,A," // FMT_19 // ")") "ISR alpha =", &
	var_list%get_rval (var_str ("isr_alpha"))
	write (u, "(2x,A," // FMT_19 // ")") "ISR Q max =", &
	var_list%get_rval (var_str ("isr_q_max"))
	write (u, "(2x,A," // FMT_19 // ")") "ISR mass =", &
	var_list%get_rval (var_str ("isr_mass"))
	write (u, "(2x,A,1x,I0)") "ISR order =", &
	var_list%get_ival (var_str ("isr_order"))
	write (u, "(2x,A,1x,L1)") "ISR recoil =", &
	var_list%get_lval (var_str ("?isr_recoil"))
	write (u, "(2x,A,1x,L1)") "ISR energy cons. =", &
	var_list%get_lval (var_str ("?isr_keep_energy"))
	end if
	if (beams%contains ("epa")) then
	write (u, "(2x,A," // FMT_19 // ")") "EPA alpha =", &
	var_list%get_rval (var_str ("epa_alpha"))
	write (u, "(2x,A," // FMT_19 // ")") "EPA x min =", &
	var_list%get_rval (var_str ("epa_x_min"))
	write (u, "(2x,A," // FMT_19 // ")") "EPA Q min =", &
	var_list%get_rval (var_str ("epa_q_min"))
	write (u, "(2x,A," // FMT_19 // ")") "EPA Q max =", &
	var_list%get_rval (var_str ("epa_q_max"))
	write (u, "(2x,A," // FMT_19 // ")") "EPA mass =", &
	var_list%get_rval (var_str ("epa_mass"))
	write (u, "(2x,A,1x,L1)") "EPA recoil =", &
	var_list%get_lval (var_str ("?epa_recoil"))
	write (u, "(2x,A,1x,L1)") "EPA energy cons. =", &
	var_list%get_lval (var_str ("?epa_keep_energy"))
	end if
	if (beams%contains ("ewa")) then
	write (u, "(2x,A," // FMT_19 // ")") "EWA x min =", &
	var_list%get_rval (var_str ("ewa_x_min"))
	write (u, "(2x,A," // FMT_19 // ")") "EWA Pt max =", &
	var_list%get_rval (var_str ("ewa_pt_max"))
	write (u, "(2x,A," // FMT_19 // ")") "EWA mass =", &
	var_list%get_rval (var_str ("ewa_mass"))
	write (u, "(2x,A,1x,L1)") "EWA recoil =", &
	var_list%get_lval (var_str ("?ewa_recoil"))
	write (u, "(2x,A,1x,L1)") "EWA energy cons. =", &
	var_list%get_lval (var_str ("ewa_keep_energy"))
	end if
	if (beams%contains ("circe1")) then
	write (u, "(2x,A,1x,I0)") "CIRCE1 version =", &
	var_list%get_ival (var_str ("circe1_ver"))
	write (u, "(2x,A,1x,I0)") "CIRCE1 revision =", &
	var_list%get_ival (var_str ("circe1_rev"))
	s = var_list%get_sval (var_str ("$circe1_acc"))
	write (u, "(2x,A,1x,A)") "CIRCE1 acceler. =", char (s)
	write (u, "(2x,A,1x,I0)") "CIRCE1 chattin. =", &
	var_list%get_ival (var_str ("circe1_chat"))
	write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 sqrts =", &
	var_list%get_rval (var_str ("circe1_sqrts"))
	write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 epsil. =", &
	var_list%get_rval (var_str ("circe1_eps"))
	write (u, "(2x,A,1x,L1)") "CIRCE1 phot. 1 =", &
	var_list%get_lval (var_str ("?circe1_photon1"))
	write (u, "(2x,A,1x,L1)") "CIRCE1 phot. 2 =", &
	var_list%get_lval (var_str ("?circe1_photon2"))
	write (u, "(2x,A,1x,L1)") "CIRCE1 generat. =", &
	var_list%get_lval (var_str ("?circe1_generate"))
	write (u, "(2x,A,1x,L1)") "CIRCE1 mapping =", &
	var_list%get_lval (var_str ("?circe1_map"))
	write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 map. slope =", &
	var_list%get_rval (var_str ("circe1_mapping_slope"))
	write (u, "(2x,A,1x,L1)") "CIRCE recoil photon =", &
	var_list%get_lval (var_str ("?circe1_with_radiation"))
	end if
	if (beams%contains ("circe2")) then
	s = var_list%get_sval (var_str ("$circe2_design"))
	write (u, "(2x,A,1x,A)") "CIRCE2 design =", char (s)
	s = var_list%get_sval (var_str ("$circe2_file"))
	write (u, "(2x,A,1x,A)") "CIRCE2 file =", char (s)
	write (u, "(2x,A,1x,L1)") "CIRCE2 polarized =", &
	var_list%get_lval (var_str ("?circe2_polarized"))
	end if
	if (beams%contains ("gaussian")) then
	write (u, "(2x,A,1x," // FMT_12 // ")") "Gaussian spread 1 =", &
	var_list%get_rval (var_str ("gaussian_spread1"))
	write (u, "(2x,A,1x," // FMT_12 // ")") "Gaussian spread 2 =", &
	var_list%get_rval (var_str ("gaussian_spread2"))
	end if
	if (beams%contains ("beam_events")) then
	s = var_list%get_sval (var_str ("$beam_events_file"))
	write (u, "(2x,A,1x,A)") "Beam events file =", char (s)
	write (u, "(2x,A,1x,L1)") "Beam events EOF warn =", &
	var_list%get_lval (var_str ("?beam_events_warn_eof"))
	end if
	end associate
	end subroutine rt_data_show_beams

	@ %def rt_data_show_beams
	@ Return the collision energy as determined by the current beam
	settings. Without beam setup, this is the [[sqrts]] variable.

	If the value is meaningless for a setup, the function returns zero.
	<<RT data: rt data: TBP>>=
	procedure :: get_sqrts => rt_data_get_sqrts
	<<RT data: sub interfaces>>=
	module function rt_data_get_sqrts (rt_data) result (sqrts)
	class(rt_data_t), intent(in) :: rt_data
	real(default) :: sqrts
	end function rt_data_get_sqrts
	<<RT data: procedures>>=
	module function rt_data_get_sqrts (rt_data) result (sqrts)
	class(rt_data_t), intent(in) :: rt_data
	real(default) :: sqrts
	sqrts = rt_data%var_list%get_rval (var_str ("sqrts"))
	end function rt_data_get_sqrts

	@ %def rt_data_get_sqrts
	@ For testing purposes, the [[rt_data_t]] contents can be pacified to
	suppress numerical fluctuations in (constant) test matrix elements.
	<<RT data: rt data: TBP>>=
	procedure :: pacify => rt_data_pacify
	<<RT data: sub interfaces>>=
	module subroutine rt_data_pacify (rt_data, efficiency_reset, error_reset)
	class(rt_data_t), intent(inout) :: rt_data
	logical, intent(in), optional :: efficiency_reset, error_reset
	end subroutine rt_data_pacify
	<<RT data: procedures>>=
	module subroutine rt_data_pacify (rt_data, efficiency_reset, error_reset)
	class(rt_data_t), intent(inout) :: rt_data
	logical, intent(in), optional :: efficiency_reset, error_reset
	type(process_entry_t), pointer :: process
	process => rt_data%process_stack%first
	do while (associated (process))
	call process%pacify (efficiency_reset, error_reset)
	process => process%next
	end do
	end subroutine rt_data_pacify

	@ %def rt_data_pacify
	@
	<<RT data: rt data: TBP>>=
	procedure :: set_event_callback => rt_data_set_event_callback
	<<RT data: sub interfaces>>=
	module subroutine rt_data_set_event_callback (global, callback)
	class(rt_data_t), intent(inout) :: global
	class(event_callback_t), intent(in) :: callback
	end subroutine rt_data_set_event_callback
	<<RT data: procedures>>=
	module subroutine rt_data_set_event_callback (global, callback)
	class(rt_data_t), intent(inout) :: global
	class(event_callback_t), intent(in) :: callback
	if (allocated (global%event_callback)) deallocate (global%event_callback)
	allocate (global%event_callback, source = callback)
	end subroutine rt_data_set_event_callback

	@ %def rt_data_set_event_callback
	@
	<<RT data: rt data: TBP>>=
	procedure :: has_event_callback => rt_data_has_event_callback
	procedure :: get_event_callback => rt_data_get_event_callback
	<<RT data: sub interfaces>>=
	module function rt_data_has_event_callback (global) result (flag)
	class(rt_data_t), intent(in) :: global
	logical :: flag
	end function rt_data_has_event_callback
	module function rt_data_get_event_callback (global) result (callback)
	class(rt_data_t), intent(in) :: global
	class(event_callback_t), allocatable :: callback
	end function rt_data_get_event_callback
	<<RT data: procedures>>=
	module function rt_data_has_event_callback (global) result (flag)
	class(rt_data_t), intent(in) :: global
	logical :: flag
	flag = allocated (global%event_callback)
	end function rt_data_has_event_callback

	module function rt_data_get_event_callback (global) result (callback)
	class(rt_data_t), intent(in) :: global
	class(event_callback_t), allocatable :: callback
	if (allocated (global%event_callback)) then
	allocate (callback, source = global%event_callback)
	end if
	end function rt_data_get_event_callback

	@ %def rt_data_has_event_callback
	@ %def rt_data_get_event_callback
	@ Force system-dependent objects to well-defined values. Some of the
	variables are locked and therefore must be addressed directly.

	This is, of course, only required for testing purposes. In principle,
	the [[real_specimen]] variables could be set to their values in
	[[rt_data_t]], but this depends on the precision again, so we set
	them to some dummy values.
	<<RT data: public>>=
	public :: fix_system_dependencies
	<<RT data: sub interfaces>>=
	module subroutine fix_system_dependencies (global)
	class(rt_data_t), intent(inout), target :: global
	end subroutine fix_system_dependencies
	<<RT data: procedures>>=
	module subroutine fix_system_dependencies (global)
	class(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list

	var_list => global%get_var_list_ptr ()
	call var_list%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true., force=.true.)
	call var_list%set_log (var_str ("?openmp_is_active"), &
	.false., is_known = .true., force=.true.)
	call var_list%set_int (var_str ("openmp_num_threads_default"), &
	1, is_known = .true., force=.true.)
	call var_list%set_int (var_str ("openmp_num_threads"), &
	1, is_known = .true., force=.true.)
	call var_list%set_int (var_str ("real_range"), &
	307, is_known = .true., force=.true.)
	call var_list%set_int (var_str ("real_precision"), &
	15, is_known = .true., force=.true.)
	call var_list%set_real (var_str ("real_epsilon"), &
	1.e-16_default, is_known = .true., force=.true.)
	call var_list%set_real (var_str ("real_tiny"), &
	1.e-300_default, is_known = .true., force=.true.)

	global%os_data%fc = "Fortran-compiler"
	global%os_data%fcflags = "Fortran-flags"
	global%os_data%fclibs = "Fortran-libs"

	end subroutine fix_system_dependencies

	@ %def fix_system_dependencies
	@
	<<RT data: public>>=
	public :: show_description_of_string
	<<RT data: sub interfaces>>=
	module subroutine show_description_of_string (string)
	type(string_t), intent(in) :: string
	end subroutine show_description_of_string
	<<RT data: procedures>>=
	module subroutine show_description_of_string (string)
	type(string_t), intent(in) :: string
	type(rt_data_t), target :: global
	call global%global_init ()
	call global%show_description_of_string (string, ascii_output=.true.)
	end subroutine show_description_of_string

	@ %def show_description_of_string
	@
	<<RT data: public>>=
	public :: show_tex_descriptions
	<<RT data: sub interfaces>>=
	module subroutine show_tex_descriptions ()
	end subroutine show_tex_descriptions
	<<RT data: procedures>>=
	module subroutine show_tex_descriptions ()
	type(rt_data_t), target :: global
	call global%global_init ()
	call fix_system_dependencies (global)
	call global%set_int (var_str ("seed"), 0, is_known=.true.)
	call global%var_list%sort ()
	call global%write_var_descriptions ()
	end subroutine show_tex_descriptions

	@ %def show_tex_descriptions
	@
	\subsection{Unit Tests}
	Test module, followed by the corresponding implementation module.
	<<[[rt_data_ut.f90]]>>=
	<<File header>>

	module rt_data_ut
	use unit_tests
	use rt_data_uti

	<<Standard module head>>

	<<RT data: public test>>

	contains

	<<RT data: test driver>>

	end module rt_data_ut
	@ %def rt_data_ut
	@
	<<[[rt_data_uti.f90]]>>=
	<<File header>>

	module rt_data_uti

	<<Use kinds>>
	<<Use strings>>
	use format_defs, only: FMT_19
	use ifiles
	use lexers
	use parser
	use flavors
	use variables, only: var_list_t
	use eval_trees
	use models
	use prclib_stacks

	use rt_data

	<<Standard module head>>

	<<RT data: test declarations>>

	contains

	<<RT data: test auxiliary>>

	<<RT data: tests>>

	end module rt_data_uti
	@ %def rt_data_ut
	@ API: driver for the unit tests below.
	<<RT data: public test>>=
	public :: rt_data_test
	<<RT data: test driver>>=
	subroutine rt_data_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<RT data: execute tests>>
	end subroutine rt_data_test

	@ %def rt_data_test
	@
	\subsubsection{Initial content}
	@
	Display the RT data in the state just after (global) initialization.
	<<RT data: execute tests>>=
	call test (rt_data_1, "rt_data_1", &
	"initialize", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_1
	<<RT data: tests>>=
	subroutine rt_data_1 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_1"
	write (u, "(A)") "* Purpose: initialize global runtime data"
	write (u, "(A)")

	call global%global_init (logfile = var_str ("rt_data.log"))
	call fix_system_dependencies (global)

	call global%set_int (var_str ("seed"), 0, is_known=.true.)

	call global%it_list%init ([2, 3], [5000, 20000])

	call global%write (u)

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_1"

	end subroutine rt_data_1

	@ %def rt_data_1
	@
	\subsubsection{Fill values}
	Fill in empty slots in the runtime data block.
	<<RT data: execute tests>>=
	call test (rt_data_2, "rt_data_2", &
	"fill", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_2
	<<RT data: tests>>=
	subroutine rt_data_2 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(flavor_t), dimension(2) :: flv
	type(string_t) :: cut_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree

	write (u, "(A)") "* Test output: rt_data_2"
	write (u, "(A)") "* Purpose: initialize global runtime data &
	&and fill contents"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call fix_system_dependencies (global)

	call global%select_model (var_str ("Test"))

	call global%set_real (var_str ("sqrts"), &
	1000._default, is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)
	call flv%init ([25,25], global%model)

	call global%set_string (var_str ("$run_id"), &
	var_str ("run1"), is_known = .true.)
	call global%set_real (var_str ("luminosity"), &
	33._default, is_known = .true.)

	call syntax_pexpr_init ()
	cut_expr_text = "all Pt > 100 [s]"
	call ifile_append (ifile, cut_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (parse_tree, stream, .true.)
	global%pn%cuts_lexpr => parse_tree%get_root_ptr ()

	allocate (global%sample_fmt (2))
	global%sample_fmt(1) = "foo_fmt"
	global%sample_fmt(2) = "bar_fmt"

	call global%write (u)

	call parse_tree_final (parse_tree)
	call stream_final (stream)
	call ifile_final (ifile)
	call syntax_pexpr_final ()

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_2"

	end subroutine rt_data_2

	@ %def rt_data_2
	@
	\subsubsection{Save and restore}
	Set up a local runtime data block, change some contents, restore the
	global block.
	<<RT data: execute tests>>=
	call test (rt_data_3, "rt_data_3", &
	"save/restore", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_3
	<<RT data: tests>>=
	subroutine rt_data_3 (u)
	use event_base, only: event_callback_nop_t
	integer, intent(in) :: u
	type(rt_data_t), target :: global, local
	type(flavor_t), dimension(2) :: flv
	type(string_t) :: cut_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree
	type(prclib_entry_t), pointer :: lib
	type(event_callback_nop_t) :: event_callback_nop

	write (u, "(A)") "* Test output: rt_data_3"
	write (u, "(A)") "* Purpose: initialize global runtime data &
	&and fill contents;"
	write (u, "(A)") "* copy to local block and back"
	write (u, "(A)")

	write (u, "(A)") "* Init global data"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call fix_system_dependencies (global)

	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%select_model (var_str ("Test"))

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call flv%init ([25,25], global%model)

	call global%beam_structure%init_sf (flv%get_name (), [1])
	call global%beam_structure%set_sf (1, 1, var_str ("pdf_builtin"))

	call global%set_string (var_str ("$run_id"), &
	var_str ("run1"), is_known = .true.)
	call global%set_real (var_str ("luminosity"), &
	33._default, is_known = .true.)

	call syntax_pexpr_init ()
	cut_expr_text = "all Pt > 100 [s]"
	call ifile_append (ifile, cut_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (parse_tree, stream, .true.)
	global%pn%cuts_lexpr => parse_tree%get_root_ptr ()

	allocate (global%sample_fmt (2))
	global%sample_fmt(1) = "foo_fmt"
	global%sample_fmt(2) = "bar_fmt"

	allocate (lib)
	call lib%init (var_str ("library_1"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Init and modify local data"
	write (u, "(A)")

	call local%local_init (global)
	call local%append_string (var_str ("$integration_method"), intrinsic=.true.)
	call local%append_string (var_str ("$phs_method"), intrinsic=.true.)

	call local%activate ()

	write (u, "(1x,A,L1)") "model associated = ", associated (local%model)
	write (u, "(1x,A,L1)") "library associated = ", associated (local%prclib)
	write (u, *)

	call local%model_set_real (var_str ("ms"), 150._default)
	call local%set_string (var_str ("$integration_method"), &
	var_str ("midpoint"), is_known = .true.)
	call local%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)

	local%os_data%fc = "Local compiler"

	allocate (lib)
	call lib%init (var_str ("library_2"))
	call local%add_prclib (lib)

	call local%set_event_callback (event_callback_nop)

	call local%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Restore global data"
	write (u, "(A)")

	call local%deactivate (global)

	write (u, "(1x,A,L1)") "model associated = ", associated (global%model)
	write (u, "(1x,A,L1)") "library associated = ", associated (global%prclib)
	write (u, *)

	call global%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call parse_tree_final (parse_tree)
	call stream_final (stream)
	call ifile_final (ifile)
	call syntax_pexpr_final ()

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_3"

	end subroutine rt_data_3

	@ %def rt_data_3
	@
	\subsubsection{Show variables}
	Display selected variables in the global record.
	<<RT data: execute tests>>=
	call test (rt_data_4, "rt_data_4", &
	"show variables", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_4
	<<RT data: tests>>=
	subroutine rt_data_4 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	type(string_t), dimension(0) :: empty_string_array

	write (u, "(A)") "* Test output: rt_data_4"
	write (u, "(A)") "* Purpose: display selected variables"
	write (u, "(A)")

	call global%global_init ()

	write (u, "(A)") "* No variables:"
	write (u, "(A)")

	call global%write_vars (u, empty_string_array)

	write (u, "(A)") "* Two variables:"
	write (u, "(A)")

	call global%write_vars (u, &
	[var_str ("?unweighted"), var_str ("$phs_method")])

	write (u, "(A)")
	write (u, "(A)") "* Display whole record with selected variables"
	write (u, "(A)")

	call global%write (u, &
	vars = [var_str ("?unweighted"), var_str ("$phs_method")])

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_4"

	end subroutine rt_data_4

	@ %def rt_data_4
	@
	\subsubsection{Show parts}
	Display only selected parts in the state just after (global) initialization.
	<<RT data: execute tests>>=
	call test (rt_data_5, "rt_data_5", &
	"show parts", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_5
	<<RT data: tests>>=
	subroutine rt_data_5 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_5"
	write (u, "(A)") "* Purpose: display parts of rt data"
	write (u, "(A)")

	call global%global_init ()
	call global%write_libraries (u)

	write (u, "(A)")

	call global%write_beams (u)

	write (u, "(A)")

	call global%write_process_stack (u)

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_5"

	end subroutine rt_data_5

	@ %def rt_data_5
	@
	\subsubsection{Local Model}
	Locally modify a model and restore the global one. We need an auxiliary
	function to determine the status of a model particle:
	<<RT data: test auxiliary>>=
	function is_stable (pdg, global) result (flag)
	integer, intent(in) :: pdg
	type(rt_data_t), intent(in) :: global
	logical :: flag
	type(flavor_t) :: flv
	call flv%init (pdg, global%model)
	flag = flv%is_stable ()
	end function is_stable

	function is_polarized (pdg, global) result (flag)
	integer, intent(in) :: pdg
	type(rt_data_t), intent(in) :: global
	logical :: flag
	type(flavor_t) :: flv
	call flv%init (pdg, global%model)
	flag = flv%is_polarized ()
	end function is_polarized

	@ %def is_stable is_polarized
	<<RT data: execute tests>>=
	call test (rt_data_6, "rt_data_6", &
	"local model", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_6
	<<RT data: tests>>=
	subroutine rt_data_6 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global, local
	type(var_list_t), pointer :: model_vars
	type(string_t) :: var_name

	write (u, "(A)") "* Test output: rt_data_6"
	write (u, "(A)") "* Purpose: apply and keep local modifications to model"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%select_model (var_str ("Test"))

	write (u, "(A)") "* Original model"
	write (u, "(A)")

	call global%write_model_list (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)

	write (u, *)

	var_name = "ff"

	write (u, "(A)", advance="no") "Global model variable: "
	model_vars => global%model%get_var_list_ptr ()
	call model_vars%write_var (var_name, u)

	write (u, "(A)")
	write (u, "(A)") "* Apply local modifications: unstable"
	write (u, "(A)")

	call local%local_init (global)
	call local%activate ()

	call local%model_set_real (var_name, 0.4_default)
	call local%modify_particle (25, stable = .false., decay = [var_str ("d1")])
	call local%modify_particle (6, stable = .false., &
	decay = [var_str ("f1")], isotropic_decay = .true.)
	call local%modify_particle (-6, stable = .false., &
	decay = [var_str ("f2"), var_str ("f3")], diagonal_decay = .true.)

	call local%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Further modifications"
	write (u, "(A)")

	call local%modify_particle (6, stable = .false., &
	decay = [var_str ("f1")], &
	diagonal_decay = .true., isotropic_decay = .false.)
	call local%modify_particle (-6, stable = .false., &
	decay = [var_str ("f2"), var_str ("f3")], &
	diagonal_decay = .false., isotropic_decay = .true.)
	call local%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Further modifications: f stable but polarized"
	write (u, "(A)")

	call local%modify_particle (6, stable = .true., polarized = .true.)
	call local%modify_particle (-6, stable = .true.)
	call local%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Global model"
	write (u, "(A)")

	call global%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)

	write (u, "(A)")
	write (u, "(A)") "* Local model"
	write (u, "(A)")

	call local%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, local)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, local)

	write (u, *)

	write (u, "(A)", advance="no") "Global model variable: "
	model_vars => global%model%get_var_list_ptr ()
	call model_vars%write_var (var_name, u)

	write (u, "(A)", advance="no") "Local model variable: "
	associate (model_var_list_ptr => local%model%get_var_list_ptr())
	call model_var_list_ptr%write_var (var_name, u)
	end associate

	write (u, "(A)")
	write (u, "(A)") "* Restore global"

	call local%deactivate (global, keep_local = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Global model"
	write (u, "(A)")

	call global%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)

	write (u, "(A)")
	write (u, "(A)") "* Local model"
	write (u, "(A)")

	call local%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, local)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, local)

	write (u, *)

	write (u, "(A)", advance="no") "Global model variable: "
	model_vars => global%model%get_var_list_ptr ()
	call model_vars%write_var (var_name, u)

	write (u, "(A)", advance="no") "Local model variable: "
	associate (model_var_list_ptr => local%model%get_var_list_ptr())
	call model_var_list_ptr%write_var (var_name, u)
	end associate

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call local%model%final ()
	deallocate (local%model)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_6"

	end subroutine rt_data_6

	@ %def rt_data_6
	@
	\subsubsection{Result variables}
	Initialize result variables and check that they are accessible via the
	global variable list.
	<<RT data: execute tests>>=
	call test (rt_data_7, "rt_data_7", &
	"result variables", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_7
	<<RT data: tests>>=
	subroutine rt_data_7 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_7"
	write (u, "(A)") "* Purpose: set and access result variables"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process variables"
	write (u, "(A)")

	call global%global_init ()
	call global%process_stack%init_result_vars (var_str ("testproc"))

	call global%var_list%write_var (&
	var_str ("integral(testproc)"), u, defined=.true.)
	call global%var_list%write_var (&
	var_str ("error(testproc)"), u, defined=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_7"

	end subroutine rt_data_7

	@ %def rt_data_7
	@
	\subsubsection{Beam energy}
	If beam parameters are set, the variable [[sqrts]] is not necessarily
	the collision energy. The method [[get_sqrts]] fetches the correct value.
	<<RT data: execute tests>>=
	call test (rt_data_8, "rt_data_8", &
	"beam energy", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_8
	<<RT data: tests>>=
	subroutine rt_data_8 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_8"
	write (u, "(A)") "* Purpose: get correct collision energy"
	write (u, "(A)")

	write (u, "(A)") "* Initialize"
	write (u, "(A)")

	call global%global_init ()

	write (u, "(A)") "* Set sqrts"
	write (u, "(A)")

	call global%set_real (var_str ("sqrts"), &
	1000._default, is_known = .true.)
	write (u, "(1x,A," // FMT_19 // ")") "sqrts =", global%get_sqrts ()

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_8"

	end subroutine rt_data_8

	@ %def rt_data_8
	@
	\subsubsection{Local variable modifications}
	<<RT data: execute tests>>=
	call test (rt_data_9, "rt_data_9", &
	"local variables", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_9
	<<RT data: tests>>=
	subroutine rt_data_9 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global, local
	type(var_list_t), pointer :: var_list

	write (u, "(A)") "* Test output: rt_data_9"
	write (u, "(A)") "* Purpose: handle local variables"
	write (u, "(A)")

	call syntax_model_file_init ()

	write (u, "(A)") "* Initialize global record and set some variables"
	write (u, "(A)")

	call global%global_init ()
	call global%select_model (var_str ("Test"))

	call global%set_real (var_str ("sqrts"), 17._default, is_known = .true.)
	call global%set_real (var_str ("luminosity"), 2._default, is_known = .true.)
	call global%model_set_real (var_str ("ff"), 0.5_default)
	call global%model_set_real (var_str ("gy"), 1.2_default)

	var_list => global%get_var_list_ptr ()

	call var_list%write_var (var_str ("sqrts"), u, defined=.true.)
	call var_list%write_var (var_str ("luminosity"), u, defined=.true.)
	call var_list%write_var (var_str ("ff"), u, defined=.true.)
	call var_list%write_var (var_str ("gy"), u, defined=.true.)
	call var_list%write_var (var_str ("mf"), u, defined=.true.)
	call var_list%write_var (var_str ("x"), u, defined=.true.)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	global%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	global%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	global%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	global%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	global%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	global%get_rval (var_str ("x"))

	write (u, "(A)")
	write (u, "(A)") "* Create local record with local variables"
	write (u, "(A)")

	call local%local_init (global)

	call local%append_real (var_str ("luminosity"), intrinsic = .true.)
	call local%append_real (var_str ("x"), user = .true.)

	call local%activate ()

	var_list => local%get_var_list_ptr ()

	call var_list%write_var (var_str ("sqrts"), u)
	call var_list%write_var (var_str ("luminosity"), u)
	call var_list%write_var (var_str ("ff"), u)
	call var_list%write_var (var_str ("gy"), u)
	call var_list%write_var (var_str ("mf"), u)
	call var_list%write_var (var_str ("x"), u, defined=.true.)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	local%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	local%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	local%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	local%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	local%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	local%get_rval (var_str ("x"))

	write (u, "(A)")
	write (u, "(A)") "* Modify some local variables"
	write (u, "(A)")

	call local%set_real (var_str ("luminosity"), 42._default, is_known=.true.)
	call local%set_real (var_str ("x"), 6.66_default, is_known=.true.)
	call local%model_set_real (var_str ("ff"), 0.7_default)

	var_list => local%get_var_list_ptr ()

	call var_list%write_var (var_str ("sqrts"), u)
	call var_list%write_var (var_str ("luminosity"), u)
	call var_list%write_var (var_str ("ff"), u)
	call var_list%write_var (var_str ("gy"), u)
	call var_list%write_var (var_str ("mf"), u)
	call var_list%write_var (var_str ("x"), u, defined=.true.)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	local%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	local%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	local%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	local%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	local%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	local%get_rval (var_str ("x"))

	write (u, "(A)")
	write (u, "(A)") "* Restore globals"
	write (u, "(A)")

	call local%deactivate (global)

	var_list => global%get_var_list_ptr ()

	call var_list%write_var (var_str ("sqrts"), u)
	call var_list%write_var (var_str ("luminosity"), u)
	call var_list%write_var (var_str ("ff"), u)
	call var_list%write_var (var_str ("gy"), u)
	call var_list%write_var (var_str ("mf"), u)
	call var_list%write_var (var_str ("x"), u, defined=.true.)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	global%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	global%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	global%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	global%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	global%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	global%get_rval (var_str ("x"))

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call local%local_final ()

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_9"

	end subroutine rt_data_9

	@ %def rt_data_9
	@
	\subsubsection{Descriptions}
	<<RT data: execute tests>>=
	call test(rt_data_10, "rt_data_10", &
	"descriptions", u, results)
	<<RT data: test declarations>>=
	public :: rt_data_10
	<<RT data: tests>>=
	subroutine rt_data_10 (u)
	integer, intent(in) :: u
	type(rt_data_t) :: global
	! type(var_list_t) :: var_list
	write (u, "(A)") "* Test output: rt_data_10"
	write (u, "(A)") "* Purpose: display descriptions"
	write (u, "(A)")

	call global%var_list%append_real (var_str ("sqrts"), &
	intrinsic=.true., &
	description=var_str ('Real variable in order to set the center-of-mass ' // &
	'energy for the collisions.'))
	call global%var_list%append_real (var_str ("luminosity"), 0._default, &
	intrinsic=.true., &
	description=var_str ('This specifier \ttt{luminosity = {\em ' // &
	'<num>}} sets the integrated luminosity (in inverse femtobarns, ' // &
	'fb${}^{-1}$) for the event generation of the processes in the ' // &
	'\sindarin\ input files.'))
	call global%var_list%append_int (var_str ("seed"), 1234, &
	intrinsic=.true., &
	description=var_str ('Integer variable \ttt{seed = {\em <num>}} ' // &
	'that allows to set a specific random seed \ttt{num}.'))
	call global%var_list%append_string (var_str ("$method"), var_str ("omega"), &
	intrinsic=.true., &
	description=var_str ('This string variable specifies the method ' // &
	'for the matrix elements to be used in the evaluation.'))
	call global%var_list%append_log (var_str ("?read_color_factors"), .true., &
	intrinsic=.true., &
	description=var_str ('This flag decides whether to read QCD ' // &
	'color factors from the matrix element provided by each method, ' // &
	'or to try and calculate the color factors in \whizard\ internally.'))

	call global%var_list%sort ()

	call global%write_var_descriptions (u)
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_10"
	end subroutine rt_data_10

	@ %def rt_data_10
	@
	\subsubsection{Export objects}
	Export objects are variables or other data that should be copied or otherwise
	applied to corresponding objects in the outer scope.

	We test appending and retrieval for the export list.
	<<RT data: execute tests>>=
	call test(rt_data_11, "rt_data_11", &
	"export objects", u, results)
	<<RT data: test declarations>>=
	public :: rt_data_11
	<<RT data: tests>>=
	subroutine rt_data_11 (u)
	integer, intent(in) :: u
	type(rt_data_t) :: global
	type(string_t), dimension(:), allocatable :: exports
	integer :: i

	write (u, "(A)") "* Test output: rt_data_11"
	write (u, "(A)") "* Purpose: handle export object list"
	write (u, "(A)")

	write (u, "(A)") "* Empty export list"
	write (u, "(A)")

	call global%write_exports (u)

	write (u, "(A)") "* Add an entry"
	write (u, "(A)")

	allocate (exports (1))
	exports(1) = var_str ("results")
	do i = 1, size (exports)
	write (u, "('+ ',A)") char (exports(i))
	end do
	write (u, *)

	call global%append_exports (exports)
	call global%write_exports (u)

	write (u, "(A)")
	write (u, "(A)") "* Add more entries, including doubler"
	write (u, "(A)")

	deallocate (exports)
	allocate (exports (3))
	exports(1) = var_str ("foo")
	exports(2) = var_str ("results")
	exports(3) = var_str ("bar")
	do i = 1, size (exports)
	write (u, "('+ ',A)") char (exports(i))
	end do
	write (u, *)

	call global%append_exports (exports)
	call global%write_exports (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_11"
	end subroutine rt_data_11

	@ %def rt_data_11
	@
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Select implementations}
	For abstract types (process core, integrator, phase space, etc.), we need a
	way to dynamically select a concrete type, using either data given by the user
	or a previous selection of a concrete type. This is done by subroutines in
	the current module.

	We would like to put this in the [[me_methods]] folder but it also
	depends on [[gosam]] and [[openloops]], so it is unclear where to put
	it.
	<<[[dispatch_me_methods.f90]]>>=
	<<File header>>

	module dispatch_me_methods

	<<Use strings>>
	<<Use debug>>
	use physics_defs, only: BORN
	use diagnostics
	use sm_qcd
	use variables, only: var_list_t
	use models
	use model_data

	use prc_core_def
	use prc_core
	use prc_test_core
	use prc_template_me
	use prc_test
	use prc_omega
	use prc_external
	use prc_gosam
	use prc_openloops
	use prc_recola
	use prc_threshold

	<<Standard module head>>

	<<Dispatch ME methods: public>>

	interface
	<<Dispatch ME methods: sub interfaces>>
	end interface

	contains

	<<Dispatch ME methods: main procedures>>

	end module dispatch_me_methods
	@ %def dispatch_me_methods
	@
	<<[[dispatch_me_methods_sub.f90]]>>=
	<<File header>>

	submodule (dispatch_me_methods) dispatch_me_methods_s

	implicit none

	contains

	<<Dispatch ME methods: procedures>>

	end submodule dispatch_me_methods_s

	@ %def dispatch_me_methods_s
	@
	\subsection{Process Core Definition}
	The [[prc_core_def_t]] abstract type can be instantiated by providing a
	[[$method]] string variable.
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<Dispatch ME methods: public>>=
	public :: dispatch_core_def
	<<Dispatch ME methods: main procedures>>=
	subroutine dispatch_core_def (core_def, prt_in, prt_out, &
	model, var_list, id, nlo_type, method)
	class(prc_core_def_t), allocatable, intent(out) :: core_def
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	type(model_t), pointer, intent(in) :: model
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in), optional :: id
	integer, intent(in), optional :: nlo_type
	type(string_t), intent(in), optional :: method
	type(string_t) :: model_name, meth
	type(string_t) :: ufo_path
	type(string_t) :: restrictions
	logical :: ufo
	logical :: cms_scheme
	logical :: openmp_support
	logical :: report_progress
	logical :: diags, diags_color
	logical :: write_phs_output
	type(string_t) :: extra_options, correction_type
	integer :: nlo
	integer :: alpha_power
	integer :: alphas_power
	if (present (method)) then
	meth = method
	else
	meth = var_list%get_sval (var_str ("$method"))
	end if
	if (debug_on) call msg_debug2 (D_CORE, "dispatch_core_def")
	if (associated (model)) then
	model_name = model%get_name ()
	cms_scheme = model%get_scheme () == "Complex_Mass_Scheme"
	ufo = model%is_ufo_model ()
	ufo_path = model%get_ufo_path ()
	else
	model_name = ""
	cms_scheme = .false.
	ufo = .false.
	end if
	restrictions = var_list%get_sval (&
	var_str ("$restrictions"))
	diags = var_list%get_lval (&
	var_str ("?vis_diags"))
	diags_color = var_list%get_lval (&
	var_str ("?vis_diags_color"))
	openmp_support = var_list%get_lval (&
	var_str ("?omega_openmp"))
	report_progress = var_list%get_lval (&
	var_str ("?report_progress"))
	write_phs_output = var_list%get_lval (&
	var_str ("?omega_write_phs_output"))
	extra_options = var_list%get_sval (&
	var_str ("$omega_flags"))
	nlo = BORN; if (present (nlo_type)) nlo = nlo_type
	alpha_power = var_list%get_ival (var_str ("alpha_power"))
	alphas_power = var_list%get_ival (var_str ("alphas_power"))
	correction_type = var_list%get_sval (var_str ("$nlo_correction_type"))
	if (debug_on) call msg_debug2 (D_CORE, "dispatching core method: ", meth)
	select case (char (meth))
	case ("unit_test")
	allocate (prc_test_def_t :: core_def)
	select type (core_def)
	type is (prc_test_def_t)
	call core_def%init (model_name, prt_in, prt_out)
	end select
	case ("template")
	allocate (template_me_def_t :: core_def)
	select type (core_def)
	type is (template_me_def_t)
	call core_def%init (model, prt_in, prt_out, unity = .false.)
	end select
	case ("template_unity")
	allocate (template_me_def_t :: core_def)
	select type (core_def)
	type is (template_me_def_t)
	call core_def%init (model, prt_in, prt_out, unity = .true.)
	end select
	case ("omega")
	allocate (omega_def_t :: core_def)
	select type (core_def)
	type is (omega_def_t)
	call core_def%init (model_name, prt_in, prt_out, &
	.false., ufo, ufo_path, &
	restrictions, cms_scheme, &
	openmp_support, report_progress, write_phs_output, &
	extra_options, diags, diags_color)
	end select
	case ("ovm")
	allocate (omega_def_t :: core_def)
	select type (core_def)
	type is (omega_def_t)
	call core_def%init (model_name, prt_in, prt_out, &
	.true., .false., var_str (""), &
	restrictions, cms_scheme, &
	openmp_support, report_progress, write_phs_output, &
	extra_options, diags, diags_color)
	end select
	case ("gosam")
	allocate (gosam_def_t :: core_def)
	select type (core_def)
	type is (gosam_def_t)
	if (present (id)) then
	call core_def%init (id, model_name, prt_in, &
	- prt_out, nlo, restrictions, var_list)
	+ prt_out, nlo, ufo, ufo_path, restrictions, var_list)
	else
	call msg_fatal ("Dispatch GoSam def: No id!")
	end if
	end select
	case ("openloops")
	allocate (openloops_def_t :: core_def)
	select type (core_def)
	type is (openloops_def_t)
	if (present (id)) then
	call core_def%init (id, model_name, prt_in, &
	- prt_out, nlo, restrictions, var_list)
	+ prt_out, nlo, ufo, ufo_path, restrictions, var_list)
	else
	call msg_fatal ("Dispatch OpenLoops def: No id!")
	end if
	end select
	case ("recola")
	call abort_if_recola_not_active ()
	allocate (recola_def_t :: core_def)
	select type (core_def)
	type is (recola_def_t)
	if (present (id)) then
	call core_def%init (id, model_name, prt_in, prt_out, &
	nlo, alpha_power, alphas_power, correction_type, &
	- restrictions)
	+ ufo, ufo_path, restrictions)
	else
	call msg_fatal ("Dispatch RECOLA def: No id!")
	end if
	end select
	case ("dummy")
	allocate (prc_external_test_def_t :: core_def)
	select type (core_def)
	type is (prc_external_test_def_t)
	if (present (id)) then
	call core_def%init (id, model_name, prt_in, prt_out)
	else
	call msg_fatal ("Dispatch User-Defined Test def: No id!")
	end if
	end select
	case ("threshold")
	allocate (threshold_def_t :: core_def)
	select type (core_def)
	type is (threshold_def_t)
	if (present (id)) then
	call core_def%init (id, model_name, prt_in, prt_out, &
	- nlo, restrictions)
	+ nlo, ufo, ufo_path, restrictions)
	else
	call msg_fatal ("Dispatch Threshold def: No id!")
	end if
	end select
	case default
	call msg_fatal ("Process configuration: method '" &
	// char (meth) // "' not implemented")
	end select
	end subroutine dispatch_core_def

	@ %def dispatch_core_def
	@
	\subsection{Process core allocation}
	Here we allocate an object of abstract type [[prc_core_t]] with a concrete
	type that matches a process definition. The [[prc_omega_t]] extension
	will require the current parameter set, so we take the opportunity to
	grab it from the model.
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<Dispatch ME methods: public>>=
	public :: dispatch_core
	<<Dispatch ME methods: main procedures>>=
	subroutine dispatch_core (core, core_def, model, &
	helicity_selection, qcd, use_color_factors, has_beam_pol)
	class(prc_core_t), allocatable, intent(inout) :: core
	class(prc_core_def_t), intent(in) :: core_def
	class(model_data_t), intent(in), target, optional :: model
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	type(qcd_t), intent(in), optional :: qcd
	logical, intent(in), optional :: use_color_factors
	logical, intent(in), optional :: has_beam_pol
	select type (core_def)
	type is (prc_test_def_t)
	allocate (test_t :: core)
	type is (template_me_def_t)
	allocate (prc_template_me_t :: core)
	select type (core)
	type is (prc_template_me_t)
	call core%set_parameters (model)
	end select
	class is (omega_def_t)
	if (.not. allocated (core)) allocate (prc_omega_t :: core)
	select type (core)
	type is (prc_omega_t)
	call core%set_parameters (model, &
	helicity_selection, qcd, use_color_factors)
	end select
	type is (gosam_def_t)
	if (.not. allocated (core)) allocate (prc_gosam_t :: core)
	select type (core)
	type is (prc_gosam_t)
	call core%set_parameters (qcd)
	end select
	type is (openloops_def_t)
	if (.not. allocated (core)) allocate (prc_openloops_t :: core)
	select type (core)
	type is (prc_openloops_t)
	call core%set_parameters (qcd)
	end select
	type is (recola_def_t)
	if (.not. allocated (core)) allocate (prc_recola_t :: core)
	select type (core)
	type is (prc_recola_t)
	call core%set_parameters (qcd, model)
	end select
	type is (prc_external_test_def_t)
	if (.not. allocated (core)) allocate (prc_external_test_t :: core)
	select type (core)
	type is (prc_external_test_t)
	call core%set_parameters (qcd, model)
	end select
	type is (threshold_def_t)
	if (.not. allocated (core)) allocate (prc_threshold_t :: core)
	select type (core)
	type is (prc_threshold_t)
	call core%set_parameters (qcd, model)
	call core%set_beam_pol (has_beam_pol)
	end select
	class default
	call msg_bug ("Process core: unexpected process definition type")
	end select
	end subroutine dispatch_core

	@ %def dispatch_core
	@
	\subsection{Process core update and restoration}
	Here we take an existing object of abstract type [[prc_core_t]] and
	update the parameters as given by the current state of [[model]].
	Optionally, we can save the previous state as [[saved_core]]. The
	second routine restores the original from the save.

	(In the test case, there is no possible update.)
	<<Dispatch ME methods: public>>=
	public :: dispatch_core_update
	public :: dispatch_core_restore
	<<Dispatch ME methods: sub interfaces>>=
	module subroutine dispatch_core_update &
	(core, model, helicity_selection, qcd, saved_core)
	class(prc_core_t), allocatable, intent(inout) :: core
	class(model_data_t), intent(in), optional, target :: model
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	type(qcd_t), intent(in), optional :: qcd
	class(prc_core_t), allocatable, intent(inout), optional :: saved_core
	end subroutine dispatch_core_update
	module subroutine dispatch_core_restore (core, saved_core)
	class(prc_core_t), allocatable, intent(inout) :: core
	class(prc_core_t), allocatable, intent(inout) :: saved_core
	end subroutine dispatch_core_restore
	<<Dispatch ME methods: procedures>>=
	module subroutine dispatch_core_update &
	(core, model, helicity_selection, qcd, saved_core)

	class(prc_core_t), allocatable, intent(inout) :: core
	class(model_data_t), intent(in), optional, target :: model
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	type(qcd_t), intent(in), optional :: qcd
	class(prc_core_t), allocatable, intent(inout), optional :: saved_core

	if (present (saved_core)) then
	allocate (saved_core, source = core)
	end if
	select type (core)
	type is (test_t)
	type is (prc_omega_t)
	call core%set_parameters (model, helicity_selection, qcd)
	call core%activate_parameters ()
	class is (prc_external_t)
	call msg_message ("Updating user defined cores is not implemented yet.")
	class default
	call msg_bug ("Process core update: unexpected process definition type")
	end select
	end subroutine dispatch_core_update

	module subroutine dispatch_core_restore (core, saved_core)

	class(prc_core_t), allocatable, intent(inout) :: core
	class(prc_core_t), allocatable, intent(inout) :: saved_core

	call move_alloc (from = saved_core, to = core)
	select type (core)
	type is (test_t)
	type is (prc_omega_t)
	call core%activate_parameters ()
	class default
	call msg_bug ("Process core restore: unexpected process definition type")
	end select
	end subroutine dispatch_core_restore

	@ %def dispatch_core_update dispatch_core_restore
	@
	\subsection{Unit Tests}
	Test module, followed by the corresponding implementation module.
	<<[[dispatch_ut.f90]]>>=
	<<File header>>

	module dispatch_ut
	use unit_tests
	use dispatch_uti

	<<Standard module head>>

	<<Dispatch: public test>>

	<<Dispatch: public test auxiliary>>

	contains

	<<Dispatch: test driver>>

	end module dispatch_ut
	@ %def dispatch_ut
	@
	<<[[dispatch_uti.f90]]>>=
	<<File header>>

	module dispatch_uti
	<<Use kinds>>
	<<Use strings>>
	use os_interface, only: os_data_t
	use physics_defs, only: ELECTRON, PROTON
	use sm_qcd, only: qcd_t
	use flavors, only: flavor_t
	use interactions, only: reset_interaction_counter
	use pdg_arrays, only: pdg_array_t, assignment(=)
	use prc_core_def, only: prc_core_def_t
	use prc_test_core, only: test_t
	use prc_core, only: prc_core_t
	use prc_test, only: prc_test_def_t
	use prc_omega, only: omega_def_t, prc_omega_t
	use sf_mappings, only: sf_channel_t
	use sf_base, only: sf_data_t, sf_config_t
	use phs_base, only: phs_channel_collection_t
	use variables, only: var_list_t
	use model_data, only: model_data_t
	use models, only: syntax_model_file_init, syntax_model_file_final
	use rt_data, only: rt_data_t

	use dispatch_phase_space, only: dispatch_sf_channels
	use dispatch_beams, only: sf_prop_t, dispatch_qcd
	use dispatch_beams, only: dispatch_sf_config, dispatch_sf_data
	use dispatch_me_methods, only: dispatch_core_def, dispatch_core
	use dispatch_me_methods, only: dispatch_core_update, dispatch_core_restore

	use sf_base_ut, only: sf_test_data_t

	<<Standard module head>>

	<<Dispatch: public test auxiliary>>

	<<Dispatch: test declarations>>

	contains

	<<Dispatch: tests>>

	<<Dispatch: test auxiliary>>

	end module dispatch_uti

	@ %def dispatch_uti
	@ API: driver for the unit tests below.
	<<Dispatch: public test>>=
	public :: dispatch_test
	<<Dispatch: test driver>>=
	subroutine dispatch_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Dispatch: execute tests>>
	end subroutine dispatch_test

	@ %def dispatch_test
	@
	\subsubsection{Select type: process definition}
	<<Dispatch: execute tests>>=
	call test (dispatch_1, "dispatch_1", &
	"process configuration method", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_1
	<<Dispatch: tests>>=
	subroutine dispatch_1 (u)
	integer, intent(in) :: u
	type(string_t), dimension(2) :: prt_in, prt_out
	type(rt_data_t), target :: global
	class(prc_core_def_t), allocatable :: core_def

	write (u, "(A)") "* Test output: dispatch_1"
	write (u, "(A)") "* Purpose: select process configuration method"
	write (u, "(A)")

	call global%global_init ()

	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	prt_in = [var_str ("a"), var_str ("b")]
	prt_out = [var_str ("c"), var_str ("d")]

	write (u, "(A)") "* Allocate core_def as prc_test_def"

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
	select type (core_def)
	type is (prc_test_def_t)
	call core_def%write (u)
	end select

	deallocate (core_def)

	write (u, "(A)")
	write (u, "(A)") "* Allocate core_def as omega_def"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("omega"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
	select type (core_def)
	type is (omega_def_t)
	call core_def%write (u)
	end select

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_1"

	end subroutine dispatch_1

	@ %def dispatch_1
	@
	\subsubsection{Select type: process core}
	<<Dispatch: execute tests>>=
	call test (dispatch_2, "dispatch_2", &
	"process core", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_2
	<<Dispatch: tests>>=
	subroutine dispatch_2 (u)
	integer, intent(in) :: u
	type(string_t), dimension(2) :: prt_in, prt_out
	type(rt_data_t), target :: global
	class(prc_core_def_t), allocatable :: core_def
	class(prc_core_t), allocatable :: core

	write (u, "(A)") "* Test output: dispatch_2"
	write (u, "(A)") "* Purpose: select process configuration method"
	write (u, "(A)") " and allocate process core"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()

	prt_in = [var_str ("a"), var_str ("b")]
	prt_out = [var_str ("c"), var_str ("d")]

	write (u, "(A)") "* Allocate core as test_t"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
	call dispatch_core (core, core_def)
	select type (core)
	type is (test_t)
	call core%write (u)
	end select

	deallocate (core)
	deallocate (core_def)

	write (u, "(A)")
	write (u, "(A)") "* Allocate core as prc_omega_t"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("omega"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)

	call global%select_model (var_str ("Test"))

	call global%set_log (&
	var_str ("?helicity_selection_active"), &
	.true., is_known = .true.)
	call global%set_real (&
	var_str ("helicity_selection_threshold"), &
	1e9_default, is_known = .true.)
	call global%set_int (&
	var_str ("helicity_selection_cutoff"), &
	10, is_known = .true.)

	call dispatch_core (core, core_def, &
	global%model, &
	global%get_helicity_selection ())
	call core_def%allocate_driver (core%driver, var_str (""))

	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_2"

	end subroutine dispatch_2

	@ %def dispatch_2
	@
	\subsubsection{Select type: structure-function data}
	This is an extra dispatcher that enables the test structure
	functions. This procedure should be assigned to the
	[[dispatch_sf_data_extra]] hook before any tests are executed.
	<<Dispatch: public test auxiliary>>=
	public :: dispatch_sf_data_test
	<<Dispatch: test auxiliary>>=
	subroutine dispatch_sf_data_test (data, sf_method, i_beam, sf_prop, &
	var_list, var_list_global, model, os_data, sqrts, pdg_in, pdg_prc, polarized)
	class(sf_data_t), allocatable, intent(inout) :: data
	type(string_t), intent(in) :: sf_method
	integer, dimension(:), intent(in) :: i_beam
	type(var_list_t), intent(in) :: var_list
	type(var_list_t), intent(inout) :: var_list_global
	class(model_data_t), target, intent(in) :: model
	type(os_data_t), intent(in) :: os_data
	real(default), intent(in) :: sqrts
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_in
	type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
	type(sf_prop_t), intent(inout) :: sf_prop
	logical, intent(in) :: polarized
	select case (char (sf_method))
	case ("sf_test_0", "sf_test_1")
	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	select case (char (sf_method))
	case ("sf_test_0"); call data%init (model, pdg_in(i_beam(1)))
	case ("sf_test_1"); call data%init (model, pdg_in(i_beam(1)),&
	mode = 1)
	end select
	end select
	end select
	end subroutine dispatch_sf_data_test

	@ %def dispatch_sf_data_test
	@ The actual test. We can't move this to [[beams]] as it depends on
	[[model_features]] for the [[model_list_t]].
	<<Dispatch: execute tests>>=
	call test (dispatch_7, "dispatch_7", &
	"structure-function data", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_7
	<<Dispatch: tests>>=
	subroutine dispatch_7 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(os_data_t) :: os_data
	type(string_t) :: prt, sf_method
	type(sf_prop_t) :: sf_prop
	class(sf_data_t), allocatable :: data
	type(pdg_array_t), dimension(1) :: pdg_in
	type(pdg_array_t), dimension(1,1) :: pdg_prc
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1

	write (u, "(A)") "* Test output: dispatch_7"
	write (u, "(A)") "* Purpose: select and configure &
	&structure function data"
	write (u, "(A)")

	call global%global_init ()

	call os_data%init ()
	call syntax_model_file_init ()
	call global%select_model (var_str ("QCD"))

	call reset_interaction_counter ()
	call global%set_real (var_str ("sqrts"), &
	14000._default, is_known = .true.)
	prt = "p"
	call global%beam_structure%init_sf ([prt, prt], [1])
	pdg_in = 2212

	write (u, "(A)") "* Allocate data as sf_pdf_builtin_t"
	write (u, "(A)")

	sf_method = "pdf_builtin"
	call dispatch_sf_data (data, sf_method, [1], sf_prop, &
	global%get_var_list_ptr (), global%var_list, &
	global%model, global%os_data, global%get_sqrts (), &
	pdg_in, pdg_prc, .false.)
	call data%write (u)

	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(A)")
	write (u, "(1x,A,99(1x,I0))") "PDG(out) = ", pdg1

	deallocate (data)

	write (u, "(A)")
	write (u, "(A)") "* Allocate data for different PDF set"
	write (u, "(A)")

	pdg_in = 2212

	call global%set_string (var_str ("$pdf_builtin_set"), &
	var_str ("CTEQ6M"), is_known = .true.)
	sf_method = "pdf_builtin"
	call dispatch_sf_data (data, sf_method, [1], sf_prop, &
	global%get_var_list_ptr (), global%var_list, &
	global%model, global%os_data, global%get_sqrts (), &
	pdg_in, pdg_prc, .false.)
	call data%write (u)

	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(A)")
	write (u, "(1x,A,99(1x,I0))") "PDG(out) = ", pdg1

	deallocate (data)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_7"

	end subroutine dispatch_7

	@ %def dispatch_7
	@
	\subsubsection{Beam structure}
	The actual test. We can't move this to [[beams]] as it depends on
	[[model_features]] for the [[model_list_t]].
	<<Dispatch: execute tests>>=
	call test (dispatch_8, "dispatch_8", &
	"beam structure", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_8
	<<Dispatch: tests>>=
	subroutine dispatch_8 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(os_data_t) :: os_data
	type(flavor_t), dimension(2) :: flv
	type(sf_config_t), dimension(:), allocatable :: sf_config
	type(sf_prop_t) :: sf_prop
	type(sf_channel_t), dimension(:), allocatable :: sf_channel
	type(phs_channel_collection_t) :: coll
	type(string_t) :: sf_string
	integer :: i
	type(pdg_array_t), dimension (2,1) :: pdg_prc

	write (u, "(A)") "* Test output: dispatch_8"
	write (u, "(A)") "* Purpose: configure a structure-function chain"
	write (u, "(A)")

	call global%global_init ()

	call os_data%init ()
	call syntax_model_file_init ()
	call global%select_model (var_str ("QCD"))

	write (u, "(A)") "* Allocate LHC beams with PDF builtin"
	write (u, "(A)")

	call flv(1)%init (PROTON, global%model)
	call flv(2)%init (PROTON, global%model)

	call reset_interaction_counter ()
	call global%set_real (var_str ("sqrts"), &
	14000._default, is_known = .true.)

	call global%beam_structure%init_sf (flv%get_name (), [1])
	call global%beam_structure%set_sf (1, 1, var_str ("pdf_builtin"))

	call dispatch_sf_config (sf_config, sf_prop, global%beam_structure, &
	global%get_var_list_ptr (), global%var_list, &
	global%model, global%os_data, global%get_sqrts (), pdg_prc)
	do i = 1, size (sf_config)
	call sf_config(i)%write (u)
	end do

	call dispatch_sf_channels (sf_channel, sf_string, sf_prop, coll, &
	global%var_list, global%get_sqrts(), global%beam_structure)
	write (u, "(1x,A)") "Mapping configuration:"
	do i = 1, size (sf_channel)
	write (u, "(2x)", advance = "no")
	call sf_channel(i)%write (u)
	end do

	write (u, "(A)")
	write (u, "(A)") "* Allocate ILC beams with CIRCE1"
	write (u, "(A)")

	call global%select_model (var_str ("QED"))
	call flv(1)%init ( ELECTRON, global%model)
	call flv(2)%init (-ELECTRON, global%model)

	call reset_interaction_counter ()
	call global%set_real (var_str ("sqrts"), &
	500._default, is_known = .true.)
	call global%set_log (var_str ("?circe1_generate"), &
	.false., is_known = .true.)

	call global%beam_structure%init_sf (flv%get_name (), [1])
	call global%beam_structure%set_sf (1, 1, var_str ("circe1"))

	call dispatch_sf_config (sf_config, sf_prop, global%beam_structure, &
	global%get_var_list_ptr (), global%var_list, &
	global%model, global%os_data, global%get_sqrts (), pdg_prc)
	do i = 1, size (sf_config)
	call sf_config(i)%write (u)
	end do

	call dispatch_sf_channels (sf_channel, sf_string, sf_prop, coll, &
	global%var_list, global%get_sqrts(), global%beam_structure)
	write (u, "(1x,A)") "Mapping configuration:"
	do i = 1, size (sf_channel)
	write (u, "(2x)", advance = "no")
	call sf_channel(i)%write (u)
	end do

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_8"

	end subroutine dispatch_8

	@ %def dispatch_8
	@
	\subsubsection{Update process core parameters}
	This test dispatches a process core, temporarily modifies parameters,
	then restores the original.
	<<Dispatch: execute tests>>=
	call test (dispatch_10, "dispatch_10", &
	"process core update", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_10
	<<Dispatch: tests>>=
	subroutine dispatch_10 (u)
	integer, intent(in) :: u
	type(string_t), dimension(2) :: prt_in, prt_out
	type(rt_data_t), target :: global
	class(prc_core_def_t), allocatable :: core_def
	class(prc_core_t), allocatable :: core, saved_core
	type(var_list_t), pointer :: model_vars

	write (u, "(A)") "* Test output: dispatch_10"
	write (u, "(A)") "* Purpose: select process configuration method,"
	write (u, "(A)") " allocate process core,"
	write (u, "(A)") " temporarily reset parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()

	prt_in = [var_str ("a"), var_str ("b")]
	prt_out = [var_str ("c"), var_str ("d")]

	write (u, "(A)") "* Allocate core as prc_omega_t"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("omega"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)

	call global%select_model (var_str ("Test"))

	call dispatch_core (core, core_def, global%model)
	call core_def%allocate_driver (core%driver, var_str (""))

	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Update core with modified model and helicity selection"
	write (u, "(A)")

	model_vars => global%model%get_var_list_ptr ()

	call model_vars%set_real (var_str ("gy"), 2._default, &
	is_known = .true.)
	call global%model%update_parameters ()

	call global%set_log (&
	var_str ("?helicity_selection_active"), &
	.true., is_known = .true.)
	call global%set_real (&
	var_str ("helicity_selection_threshold"), &
	2e10_default, is_known = .true.)
	call global%set_int (&
	var_str ("helicity_selection_cutoff"), &
	5, is_known = .true.)

	call dispatch_core_update (core, &
	global%model, &
	global%get_helicity_selection (), &
	saved_core = saved_core)
	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Restore core from save"
	write (u, "(A)")

	call dispatch_core_restore (core, saved_core)
	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_10"

	end subroutine dispatch_10

	@ %def dispatch_10
	@
	\subsubsection{QCD Coupling}
	This test dispatches an [[qcd]] object, which is used to compute the
	(running) coupling by one of several possible methods.

	We can't move this to [[beams]] as it depends on
	[[model_features]] for the [[model_list_t]].
	<<Dispatch: execute tests>>=
	call test (dispatch_11, "dispatch_11", &
	"QCD coupling", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_11
	<<Dispatch: tests>>=
	subroutine dispatch_11 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(var_list_t), pointer :: model_vars
	type(qcd_t) :: qcd

	write (u, "(A)") "* Test output: dispatch_11"
	write (u, "(A)") "* Purpose: select QCD coupling formula"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%select_model (var_str ("SM"))
	model_vars => global%get_var_list_ptr ()

	write (u, "(A)") "* Allocate alpha_s as fixed"
	write (u, "(A)")

	call global%set_log (var_str ("?alphas_is_fixed"), &
	.true., is_known = .true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate alpha_s as running (built-in)"
	write (u, "(A)")

	call global%set_log (var_str ("?alphas_is_fixed"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?alphas_from_mz"), &
	.true., is_known = .true.)
	call global%set_int &
	(var_str ("alphas_order"), 1, is_known = .true.)
	call model_vars%set_real (var_str ("alphas"), 0.1234_default, &
	is_known=.true.)
	call model_vars%set_real (var_str ("mZ"), 91.234_default, &
	is_known=.true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate alpha_s as running (built-in, Lambda defined)"
	write (u, "(A)")

	call global%set_log (var_str ("?alphas_from_mz"), &
	.false., is_known = .true.)
	call global%set_log (&
	var_str ("?alphas_from_lambda_qcd"), &
	.true., is_known = .true.)
	call global%set_real &
	(var_str ("lambda_qcd"), 250.e-3_default, &
	is_known=.true.)
	call global%set_int &
	(var_str ("alphas_order"), 2, is_known = .true.)
	call global%set_int &
	(var_str ("alphas_nf"), 4, is_known = .true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate alpha_s as running (using builtin PDF set)"
	write (u, "(A)")

	call global%set_log (&
	var_str ("?alphas_from_lambda_qcd"), &
	.false., is_known = .true.)
	call global%set_log &
	(var_str ("?alphas_from_pdf_builtin"), &
	.true., is_known = .true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_11"

	end subroutine dispatch_11

	@ %def dispatch_11
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process Configuration}
	This module communicates between the toplevel command structure with
	its runtime data set and the process-library handling modules which
	collect the definition of individual processes. Its primary purpose
	is to select from the available matrix-element generating methods and
	configure the entry in the process library accordingly.
	<<[[process_configurations.f90]]>>=
	<<File header>>

	module process_configurations

	<<Use strings>>
	use models
	use particle_specifiers
	use process_libraries
	use rt_data
	use variables, only: var_list_t

	<<Standard module head>>

	<<Process configurations: public>>

	<<Process configurations: types>>

	interface
	<<Process configurations: sub interfaces>>
	end interface

	end module process_configurations
	@ %def process_configurations
	@
	<<[[process_configurations_sub.f90]]>>=
	<<File header>>

	submodule (process_configurations) process_configurations_s

	<<Use debug>>
	use diagnostics
	use io_units
	use physics_defs, only: BORN, NLO_VIRTUAL, NLO_REAL, NLO_DGLAP, &
	NLO_SUBTRACTION, NLO_MISMATCH
	use prc_core_def
	use dispatch_me_methods, only: dispatch_core_def
	use prc_external, only: prc_external_def_t
	!!! Intel oneAPI 2022/23 regression workaround
	use variables, only: var_list_t

	implicit none

	contains

	<<Process configurations: procedures>>

	end submodule process_configurations_s

	@ %def process_configurations_s
	@
	\subsection{Data Type}
	<<Process configurations: public>>=
	public :: process_configuration_t
	<<Process configurations: types>>=
	type :: process_configuration_t
	type(process_def_entry_t), pointer :: entry => null ()
	type(string_t) :: id
	integer :: num_id = 0
	contains
	<<Process configurations: process configuration: TBP>>
	end type process_configuration_t

	@ %def process_configuration_t
	@ Output (for unit tests).
	<<Process configurations: process configuration: TBP>>=
	procedure :: write => process_configuration_write
	<<Process configurations: sub interfaces>>=
	module subroutine process_configuration_write (config, unit)
	class(process_configuration_t), intent(in) :: config
	integer, intent(in), optional :: unit
	end subroutine process_configuration_write
	<<Process configurations: procedures>>=
	module subroutine process_configuration_write (config, unit)
	class(process_configuration_t), intent(in) :: config
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(A)") "Process configuration:"
	if (associated (config%entry)) then
	call config%entry%write (u)
	else
	write (u, "(1x,3A)") "ID = '", char (config%id), "'"
	write (u, "(1x,A,1x,I0)") "num ID =", config%num_id
	write (u, "(2x,A)") "[no entry]"
	end if
	end subroutine process_configuration_write

	@ %def process_configuration_write
	@ Initialize a process. We only need the name, the number of incoming
	particles, and the number of components.
	<<Process configurations: process configuration: TBP>>=
	procedure :: init => process_configuration_init
	<<Process configurations: sub interfaces>>=
	module subroutine process_configuration_init &
	(config, prc_name, n_in, n_components, model, var_list, &
	nlo_process, negative_sf)
	class(process_configuration_t), intent(out) :: config
	type(string_t), intent(in) :: prc_name
	integer, intent(in) :: n_in
	integer, intent(in) :: n_components
	type(model_t), intent(in), pointer :: model
	type(var_list_t), intent(in) :: var_list
	logical, intent(in), optional :: nlo_process, negative_sf
	end subroutine process_configuration_init
	<<Process configurations: procedures>>=
	module subroutine process_configuration_init &
	(config, prc_name, n_in, n_components, model, var_list, &
	nlo_process, negative_sf)
	class(process_configuration_t), intent(out) :: config
	type(string_t), intent(in) :: prc_name
	integer, intent(in) :: n_in
	integer, intent(in) :: n_components
	type(model_t), intent(in), pointer :: model
	type(var_list_t), intent(in) :: var_list
	logical, intent(in), optional :: nlo_process, negative_sf
	logical :: nlo_proc, neg_sf
	logical :: requires_resonances
	if (debug_on) call msg_debug (D_CORE, "process_configuration_init")
	config%id = prc_name
	if (present (nlo_process)) then
	nlo_proc = nlo_process
	else
	nlo_proc = .false.
	end if
	if (present (negative_sf)) then
	neg_sf = negative_sf
	else
	neg_sf = .false.
	end if
	requires_resonances = var_list%get_lval (var_str ("?resonance_history"))

	if (debug_on) call msg_debug (D_CORE, "nlo_process", nlo_proc)
	allocate (config%entry)
	if (var_list%is_known (var_str ("process_num_id"))) then
	config%num_id = &
	var_list%get_ival (var_str ("process_num_id"))
	call config%entry%init (prc_name, &
	model = model, n_in = n_in, n_components = n_components, &
	num_id = config%num_id, &
	nlo_process = nlo_proc, &
	negative_sf = neg_sf, &
	requires_resonances = requires_resonances)
	else
	call config%entry%init (prc_name, &
	model = model, n_in = n_in, n_components = n_components, &
	nlo_process = nlo_proc, &
	negative_sf = neg_sf, &
	requires_resonances = requires_resonances)
	end if
	end subroutine process_configuration_init

	@ %def process_configuration_init
	@ Initialize a process component. The details depend on the process method,
	which determines the type of the process component core. We set the incoming
	and outgoing particles (as strings, to be interpreted by the process driver).
	All other information is taken from the variable list.

	The dispatcher gets only the names of the particles. The process
	component definition gets the complete specifiers which contains a
	polarization flag and names of decay processes, where applicable.
	<<Process configurations: process configuration: TBP>>=
	procedure :: setup_component => process_configuration_setup_component
	<<Process configurations: sub interfaces>>=
	module subroutine process_configuration_setup_component &
	(config, i_component, prt_in, prt_out, model, var_list, &
	nlo_type, can_be_integrated)
	class(process_configuration_t), intent(inout) :: config
	integer, intent(in) :: i_component
	type(prt_spec_t), dimension(:), intent(in) :: prt_in
	type(prt_spec_t), dimension(:), intent(in) :: prt_out
	type(model_t), pointer, intent(in) :: model
	type(var_list_t), intent(in) :: var_list
	integer, intent(in), optional :: nlo_type
	logical, intent(in), optional :: can_be_integrated
	end subroutine process_configuration_setup_component
	<<Process configurations: procedures>>=
	module subroutine process_configuration_setup_component &
	(config, i_component, prt_in, prt_out, model, var_list, &
	nlo_type, can_be_integrated)
	class(process_configuration_t), intent(inout) :: config
	integer, intent(in) :: i_component
	type(prt_spec_t), dimension(:), intent(in) :: prt_in
	type(prt_spec_t), dimension(:), intent(in) :: prt_out
	type(model_t), pointer, intent(in) :: model
	type(var_list_t), intent(in) :: var_list
	integer, intent(in), optional :: nlo_type
	logical, intent(in), optional :: can_be_integrated
	type(string_t), dimension(:), allocatable :: prt_str_in
	type(string_t), dimension(:), allocatable :: prt_str_out
	class(prc_core_def_t), allocatable :: core_def
	type(string_t) :: method
	type(string_t) :: born_me_method
	type(string_t) :: real_tree_me_method
	type(string_t) :: loop_me_method
	type(string_t) :: correlation_me_method
	type(string_t) :: dglap_me_method
	integer :: i
	if (debug_on) call msg_debug2 &
	(D_CORE, "process_configuration_setup_component")
	allocate (prt_str_in (size (prt_in)))
	allocate (prt_str_out (size (prt_out)))
	forall (i = 1:size (prt_in)) prt_str_in(i) = prt_in(i)% get_name ()
	forall (i = 1:size (prt_out)) prt_str_out(i) = prt_out(i)%get_name ()

	method = var_list%get_sval (var_str ("$method"))
	if (present (nlo_type)) then
	select case (nlo_type)
	case (BORN)
	born_me_method = var_list%get_sval (var_str ("$born_me_method"))
	if (born_me_method /= var_str ("")) then
	method = born_me_method
	end if
	case (NLO_VIRTUAL)
	loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
	if (loop_me_method /= var_str ("")) then
	method = loop_me_method
	end if
	case (NLO_REAL)
	real_tree_me_method = &
	var_list%get_sval (var_str ("$real_tree_me_method"))
	if (real_tree_me_method /= var_str ("")) then
	method = real_tree_me_method
	end if
	case (NLO_DGLAP)
	dglap_me_method = &
	var_list%get_sval (var_str ("$dglap_me_method"))
	if (dglap_me_method /= var_str ("")) then
	method = dglap_me_method
	end if
	case (NLO_SUBTRACTION,NLO_MISMATCH)
	correlation_me_method = &
	var_list%get_sval (var_str ("$correlation_me_method"))
	if (correlation_me_method /= var_str ("")) then
	method = correlation_me_method
	end if
	case default
	end select
	end if
	call dispatch_core_def (core_def, prt_str_in, prt_str_out, &
	model, var_list, config%id, nlo_type, method)
	select type (core_def)
	class is (prc_external_def_t)
	if (present (can_be_integrated)) then
	call core_def%set_active_writer (can_be_integrated)
	else
	call msg_fatal ("Cannot decide if external core is integrated!")
	end if
	end select

	if (debug_on) call msg_debug2 &
	(D_CORE, "import_component with method ", method)
	call config%entry%import_component (i_component, &
	n_out = size (prt_out), &
	prt_in = prt_in, &
	prt_out = prt_out, &
	method = method, &
	variant = core_def, &
	nlo_type = nlo_type, &
	can_be_integrated = can_be_integrated)
	end subroutine process_configuration_setup_component

	@ %def process_configuration_setup_component
	@
	<<Process configurations: process configuration: TBP>>=
	procedure :: set_fixed_emitter => process_configuration_set_fixed_emitter
	<<Process configurations: sub interfaces>>=
	module subroutine process_configuration_set_fixed_emitter &
	(config, i, emitter)
	class(process_configuration_t), intent(inout) :: config
	integer, intent(in) :: i, emitter
	end subroutine process_configuration_set_fixed_emitter
	<<Process configurations: procedures>>=
	module subroutine process_configuration_set_fixed_emitter (config, i, emitter)
	class(process_configuration_t), intent(inout) :: config
	integer, intent(in) :: i, emitter
	call config%entry%set_fixed_emitter (i, emitter)
	end subroutine process_configuration_set_fixed_emitter

	@ %def process_configuration_set_fixed_emitter
	@
	<<Process configurations: process configuration: TBP>>=
	procedure :: set_coupling_powers => process_configuration_set_coupling_powers
	<<Process configurations: sub interfaces>>=
	module subroutine process_configuration_set_coupling_powers &
	(config, alpha_power, alphas_power)
	class(process_configuration_t), intent(inout) :: config
	integer, intent(in) :: alpha_power, alphas_power
	end subroutine process_configuration_set_coupling_powers
	<<Process configurations: procedures>>=
	module subroutine process_configuration_set_coupling_powers &
	(config, alpha_power, alphas_power)
	class(process_configuration_t), intent(inout) :: config
	integer, intent(in) :: alpha_power, alphas_power
	call config%entry%set_coupling_powers (alpha_power, alphas_power)
	end subroutine process_configuration_set_coupling_powers

	@ %def process_configuration_set_coupling_powers
	@
	<<Process configurations: process configuration: TBP>>=
	procedure :: set_component_associations => &
	process_configuration_set_component_associations
	<<Process configurations: sub interfaces>>=
	module subroutine process_configuration_set_component_associations &
	(config, i_list, remnant, use_real_finite, mismatch)
	class(process_configuration_t), intent(inout) :: config
	integer, dimension(:), intent(in) :: i_list
	logical, intent(in) :: remnant, use_real_finite, mismatch
	end subroutine process_configuration_set_component_associations
	<<Process configurations: procedures>>=
	module subroutine process_configuration_set_component_associations &
	(config, i_list, remnant, use_real_finite, mismatch)
	class(process_configuration_t), intent(inout) :: config
	integer, dimension(:), intent(in) :: i_list
	logical, intent(in) :: remnant, use_real_finite, mismatch
	integer :: i_component
	do i_component = 1, config%entry%get_n_components ()
	if (any (i_list == i_component)) then
	call config%entry%set_associated_components (i_component, &
	i_list, remnant, use_real_finite, mismatch)
	end if
	end do
	end subroutine process_configuration_set_component_associations

	@ %def process_configuration_set_component_associations
	@ Record a process configuration: append it to the currently selected process
	definition library.
	<<Process configurations: process configuration: TBP>>=
	procedure :: record => process_configuration_record
	<<Process configurations: sub interfaces>>=
	module subroutine process_configuration_record (config, global)
	class(process_configuration_t), intent(inout) :: config
	type(rt_data_t), intent(inout) :: global
	end subroutine process_configuration_record
	<<Process configurations: procedures>>=
	module subroutine process_configuration_record (config, global)
	class(process_configuration_t), intent(inout) :: config
	type(rt_data_t), intent(inout) :: global
	if (associated (global%prclib)) then
	call global%prclib%open ()
	call global%prclib%append (config%entry)
	if (config%num_id /= 0) then
	write (msg_buffer, "(5A,I0,A)") "Process library '", &
	char (global%prclib%get_name ()), &
	"': recorded process '", char (config%id), "' (", &
	config%num_id, ")"
	else
	write (msg_buffer, "(5A)") "Process library '", &
	char (global%prclib%get_name ()), &
	"': recorded process '", char (config%id), "'"
	end if
	call msg_message ()
	else
	call msg_fatal ("Recording process '" // char (config%id) &
	// "': active process library undefined")
	end if
	end subroutine process_configuration_record

	@ %def process_configuration_record
	@
	\subsection{Unit Tests}
	Test module, followed by the corresponding implementation module.
	<<[[process_configurations_ut.f90]]>>=
	<<File header>>

	module process_configurations_ut
	use unit_tests
	use process_configurations_uti

	<<Standard module head>>

	<<Process configurations: public test>>

	<<Process configurations: public test auxiliary>>

	contains

	<<Process configurations: test driver>>

	end module process_configurations_ut
	@ %def process_configurations_ut
	@
	<<[[process_configurations_uti.f90]]>>=
	<<File header>>

	module process_configurations_uti

	<<Use strings>>
	use particle_specifiers, only: new_prt_spec
	use prclib_stacks
	use models
	use rt_data

	use process_configurations

	<<Standard module head>>

	<<Process configurations: test declarations>>

	<<Process configurations: public test auxiliary>>

	contains

	<<Process configurations: test auxiliary>>

	<<Process configurations: tests>>

	end module process_configurations_uti

	@ %def process_configurations_uti
	@ API: driver for the unit tests below.
	<<Process configurations: public test>>=
	public :: process_configurations_test
	<<Process configurations: test driver>>=
	subroutine process_configurations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Process configurations: execute tests>>
	end subroutine process_configurations_test

	@ %def process_configurations_test
	@
	\subsubsection{Minimal setup}
	The workflow for setting up a minimal process configuration with the
	test matrix element method.

	We wrap this in a public procedure, so we can reuse it in later modules.
	The procedure prepares a process definition list for two processes
	(one [[prc_test]] and one [[omega]] type) and appends this to the
	process library stack in the global data set.

	The [[mode]] argument determines which processes to build.

	The [[procname]] argument replaces the predefined procname(s).

	This is re-exported by the UT module.
	<<Process configurations: public test auxiliary>>=
	public :: prepare_test_library
	<<Process configurations: test auxiliary>>=
	subroutine prepare_test_library (global, libname, mode, procname)
	type(rt_data_t), intent(inout), target :: global
	type(string_t), intent(in) :: libname
	integer, intent(in) :: mode
	type(string_t), intent(in), dimension(:), optional :: procname
	type(prclib_entry_t), pointer :: lib
	type(string_t) :: prc_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	integer :: n_components
	type(process_configuration_t) :: prc_config

	if (.not. associated (global%prclib_stack%get_first_ptr ())) then
	allocate (lib)
	call lib%init (libname)
	call global%add_prclib (lib)
	end if

	if (btest (mode, 0)) then

	call global%select_model (var_str ("Test"))

	if (present (procname)) then
	prc_name = procname(1)
	else
	prc_name = "prc_config_a"
	end if
	n_components = 1
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("s"), var_str ("s")]
	prt_out = [var_str ("s"), var_str ("s")]

	call global%set_string (var_str ("$method"),&
	var_str ("unit_test"), is_known = .true.)

	call prc_config%init (prc_name, &
	size (prt_in), n_components, &
	global%model, global%var_list)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), &
	global%model, global%var_list)
	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	end if

	if (btest (mode, 1)) then

	call global%select_model (var_str ("QED"))

	if (present (procname)) then
	prc_name = procname(2)
	else
	prc_name = "prc_config_b"
	end if
	n_components = 1
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("m+"), var_str ("m-")]

	call global%set_string (var_str ("$method"),&
	var_str ("omega"), is_known = .true.)

	call prc_config%init (prc_name, &
	size (prt_in), n_components, &
	global%model, global%var_list)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), &
	global%model, global%var_list)
	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	end if

	if (btest (mode, 2)) then

	call global%select_model (var_str ("Test"))

	if (present (procname)) then
	prc_name = procname(1)
	else
	prc_name = "prc_config_a"
	end if
	n_components = 1
	allocate (prt_in (1), prt_out (2))
	prt_in = [var_str ("s")]
	prt_out = [var_str ("f"), var_str ("fbar")]

	call global%set_string (var_str ("$method"),&
	var_str ("unit_test"), is_known = .true.)

	call prc_config%init (prc_name, &
	size (prt_in), n_components, &
	global%model, global%var_list)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), &
	global%model, global%var_list)
	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	end if

	end subroutine prepare_test_library

	@ %def prepare_test_library
	@ The actual test: the previous procedure with some prelude and postlude.
	In the global variable list, just before printing we reset the
	variables where the value may depend on the system and run environment.
	<<Process configurations: execute tests>>=
	call test (process_configurations_1, "process_configurations_1", &
	"test processes", &
	u, results)
	<<Process configurations: test declarations>>=
	public :: process_configurations_1
	<<Process configurations: tests>>=
	subroutine process_configurations_1 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: process_configurations_1"
	write (u, "(A)") "* Purpose: configure test processes"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	write (u, "(A)") "* Configure processes as prc_test, model Test"
	write (u, "(A)") "* and omega, model QED"
	write (u, *)

	call global%set_int (var_str ("process_num_id"), &
	42, is_known = .true.)
	call prepare_test_library (global, var_str ("prc_config_lib_1"), 3)

	global%os_data%fc = "Fortran-compiler"
	global%os_data%fcflags = "Fortran-flags"
	global%os_data%fclibs = "Fortran-libs"

	call global%write_libraries (u)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: process_configurations_1"

	end subroutine process_configurations_1

	@ %def process_configurations_1
	@
	\subsubsection{\oMega\ options}
	Slightly extended example where we pass \oMega\ options to the
	library. The [[prepare_test_library]] contents are spelled out.
	<<Process configurations: execute tests>>=
	call test (process_configurations_2, "process_configurations_2", &
	"omega options", &
	u, results)
	<<Process configurations: test declarations>>=
	public :: process_configurations_2
	<<Process configurations: tests>>=
	subroutine process_configurations_2 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	type(string_t) :: libname
	type(prclib_entry_t), pointer :: lib
	type(string_t) :: prc_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	integer :: n_components
	type(process_configuration_t) :: prc_config

	write (u, "(A)") "* Test output: process_configurations_2"
	write (u, "(A)") "* Purpose: configure test processes with options"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	write (u, "(A)") "* Configure processes as omega, model QED"
	write (u, *)

	libname = "prc_config_lib_2"

	allocate (lib)
	call lib%init (libname)
	call global%add_prclib (lib)

	call global%select_model (var_str ("QED"))

	prc_name = "prc_config_c"
	n_components = 2
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("m+"), var_str ("m-")]

	call global%set_string (var_str ("$method"),&
	var_str ("omega"), is_known = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	call prc_config%init (prc_name, size (prt_in), n_components, &
	global%model, global%var_list)

	call global%set_log (var_str ("?report_progress"), &
	.true., is_known = .true.)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)

	call global%set_log (var_str ("?report_progress"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.true., is_known = .true.)
	call global%set_string (var_str ("$restrictions"),&
	var_str ("3+4~A"), is_known = .true.)
	call global%set_string (var_str ("$omega_flags"), &
	var_str ("-fusion:progress_file omega_prc_config.log"), &
	is_known = .true.)
	call prc_config%setup_component (2, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)

	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	global%os_data%fc = "Fortran-compiler"
	global%os_data%fcflags = "Fortran-flags"
	global%os_data%fclibs = "Fortran-libs"

	call global%write_vars (u, [ &
	var_str ("$model_name"), &
	var_str ("$method"), &
	var_str ("?report_progress"), &
	var_str ("$restrictions"), &
	var_str ("$omega_flags")])
	write (u, "(A)")
	call global%write_libraries (u)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: process_configurations_2"

	end subroutine process_configurations_2

	@ %def process_configurations_2
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Compilation}
	This module manages compilation and loading of of process libraries. It is
	needed as a separate module because integration depends on it.
	<<[[compilations.f90]]>>=
	<<File header>>

	module compilations

	<<Use strings>>
	use os_interface
	use variables, only: var_list_t
	use model_data
	use process_libraries
	use prclib_stacks
	use rt_data

	<<Standard module head>>

	<<Compilations: public>>

	<<Compilations: types>>

	<<Compilations: parameters>>

	interface
	<<Compilations: sub interfaces>>
	end interface

	end module compilations
	@ %def compilations
	@
	<<[[compilations_sub.f90]]>>=
	<<File header>>

	submodule (compilations) compilations_s

	use io_units
	use system_defs, only: TAB
	use system_dependencies, only: OS_IS_DARWIN
	use diagnostics
	!!! Intel oneAPI 2022/23 regression workaround
	use variables, only: var_list_t

	implicit none

	contains

	<<Compilations: procedures>>

	end submodule compilations_s

	@ %def compilations_s
	@
	\subsection{The data type}
	The compilation item handles the compilation and loading of a single
	process library.
	<<Compilations: public>>=
	public :: compilation_item_t
	<<Compilations: types>>=
	type :: compilation_item_t
	private
	type(string_t) :: libname
	type(string_t) :: static_external_tag
	type(process_library_t), pointer :: lib => null ()
	logical :: recompile_library = .false.
	logical :: verbose = .false.
	logical :: use_workspace = .false.
	type(string_t) :: workspace
	contains
	<<Compilations: compilation item: TBP>>
	end type compilation_item_t

	@ %def compilation_item_t
	@ Initialize.

	Set flags and global properties of the library. Establish the workspace name,
	if defined.
	<<Compilations: compilation item: TBP>>=
	procedure :: init => compilation_item_init
	<<Compilations: sub interfaces>>=
	module subroutine compilation_item_init (comp, libname, stack, var_list)
	class(compilation_item_t), intent(out) :: comp
	type(string_t), intent(in) :: libname
	type(prclib_stack_t), intent(inout) :: stack
	type(var_list_t), intent(in) :: var_list
	end subroutine compilation_item_init
	<<Compilations: procedures>>=
	module subroutine compilation_item_init (comp, libname, stack, var_list)
	class(compilation_item_t), intent(out) :: comp
	type(string_t), intent(in) :: libname
	type(prclib_stack_t), intent(inout) :: stack
	type(var_list_t), intent(in) :: var_list
	comp%libname = libname
	comp%lib => stack%get_library_ptr (comp%libname)
	if (.not. associated (comp%lib)) then
	call msg_fatal ("Process library '" // char (comp%libname) &
	// "' has not been declared.")
	end if
	comp%recompile_library = &
	var_list%get_lval (var_str ("?recompile_library"))
	comp%verbose = &
	var_list%get_lval (var_str ("?me_verbose"))
	comp%use_workspace = &
	var_list%is_known (var_str ("$compile_workspace"))
	if (comp%use_workspace) then
	comp%workspace = &
	var_list%get_sval (var_str ("$compile_workspace"))
	if (comp%workspace == "") comp%use_workspace = .false.
	else
	comp%workspace = ""
	end if
	end subroutine compilation_item_init

	@ %def compilation_item_init
	@ Compile the current library. The [[force]] flag has the
	effect that we first delete any previous files, as far as accessible
	by the current makefile. It also guarantees that previous files not
	accessible by a makefile will be overwritten.
	<<Compilations: compilation item: TBP>>=
	procedure :: compile => compilation_item_compile
	<<Compilations: sub interfaces>>=
	module subroutine compilation_item_compile &
	(comp, model, os_data, force, recompile)
	class(compilation_item_t), intent(inout) :: comp
	class(model_data_t), intent(in), target :: model
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: force, recompile
	end subroutine compilation_item_compile
	<<Compilations: procedures>>=
	module subroutine compilation_item_compile &
	(comp, model, os_data, force, recompile)
	class(compilation_item_t), intent(inout) :: comp
	class(model_data_t), intent(in), target :: model
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: force, recompile
	if (associated (comp%lib)) then
	if (comp%use_workspace) call setup_workspace (comp%workspace, os_data)
	call msg_message ("Process library '" &
	// char (comp%libname) // "': compiling ...")
	call comp%lib%configure (os_data)
	if (signal_is_pending ()) return
	call comp%lib%compute_md5sum (model)
	call comp%lib%write_makefile &
	(os_data, force, verbose=comp%verbose, workspace=comp%workspace)
	if (signal_is_pending ()) return
	if (force) then
	call comp%lib%clean &
	(os_data, distclean = .false., workspace=comp%workspace)
	if (signal_is_pending ()) return
	end if
	call comp%lib%write_driver (force, workspace=comp%workspace)
	if (signal_is_pending ()) return
	if (recompile) then
	call comp%lib%load &
	(os_data, keep_old_source = .true., workspace=comp%workspace)
	if (signal_is_pending ()) return
	end if
	call comp%lib%update_status (os_data, workspace=comp%workspace)
	end if
	end subroutine compilation_item_compile

	@ %def compilation_item_compile
	@ The workspace directory is created if it does not exist. (Applies only if
	the use has set the workspace directory.)
	<<Compilations: parameters>>=
	character(*), parameter :: ALLOWED_IN_DIRNAME = &
	"abcdefghijklmnopqrstuvwxyz&
	&ABCDEFGHIJKLMNOPQRSTUVWXYZ&
	&1234567890&
	&.,_-+="
	@ %def ALLOWED_IN_DIRNAME
	<<Compilations: procedures>>=
	subroutine setup_workspace (workspace, os_data)
	type(string_t), intent(in) :: workspace
	type(os_data_t), intent(in) :: os_data
	if (verify (workspace, ALLOWED_IN_DIRNAME) == 0) then
	call msg_message ("Compile: preparing workspace directory '" &
	// char (workspace) // "'")
	call os_system_call ("mkdir -p '" // workspace // "'")
	else
	call msg_fatal ("compile: workspace name '" &
	// char (workspace) // "' contains illegal characters")
	end if
	end subroutine setup_workspace

	@ %def setup_workspace
	@ Load the current library, just after compiling it.
	<<Compilations: compilation item: TBP>>=
	procedure :: load => compilation_item_load
	<<Compilations: sub interfaces>>=
	module subroutine compilation_item_load (comp, os_data)
	class(compilation_item_t), intent(inout) :: comp
	type(os_data_t), intent(in) :: os_data
	end subroutine compilation_item_load
	<<Compilations: procedures>>=
	module subroutine compilation_item_load (comp, os_data)
	class(compilation_item_t), intent(inout) :: comp
	type(os_data_t), intent(in) :: os_data
	if (associated (comp%lib)) then
	call comp%lib%load (os_data, workspace=comp%workspace)
	end if
	end subroutine compilation_item_load

	@ %def compilation_item_load
	@ Message as a separate call:
	<<Compilations: compilation item: TBP>>=
	procedure :: success => compilation_item_success
	<<Compilations: sub interfaces>>=
	module subroutine compilation_item_success (comp)
	class(compilation_item_t), intent(in) :: comp
	end subroutine compilation_item_success
	<<Compilations: procedures>>=
	module subroutine compilation_item_success (comp)
	class(compilation_item_t), intent(in) :: comp
	if (associated (comp%lib)) then
	call msg_message ("Process library '" // char (comp%libname) &
	// "': ... success.")
	else
	call msg_fatal ("Process library '" // char (comp%libname) &
	// "': ... failure.")
	end if
	end subroutine compilation_item_success

	@ %def compilation_item_success
	@ %def compilation_item_failure
	@
	\subsection{API for library compilation and loading}
	This is a shorthand for compiling and loading a single library. The
	[[compilation_item]] object is used only internally.

	The [[global]] data set may actually be local to the caller. The
	compilation affects the library specified by its name if it is on the
	stack, but it does not reset the currently selected library.
	<<Compilations: public>>=
	public :: compile_library
	<<Compilations: sub interfaces>>=
	module subroutine compile_library (libname, global)
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: global
	end subroutine compile_library
	<<Compilations: procedures>>=
	module subroutine compile_library (libname, global)
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: global
	type(compilation_item_t) :: comp
	logical :: force, recompile
	force = &
	global%var_list%get_lval (var_str ("?rebuild_library"))
	recompile = &
	global%var_list%get_lval (var_str ("?recompile_library"))
	if (associated (global%model)) then
	call comp%init (libname, global%prclib_stack, global%var_list)
	call comp%compile (global%model, global%os_data, force, recompile)
	if (signal_is_pending ()) return
	call comp%load (global%os_data)
	if (signal_is_pending ()) return
	else
	call msg_fatal ("Process library compilation: " &
	// " model is undefined.")
	end if
	call comp%success ()
	end subroutine compile_library

	@ %def compile_library
	@
	\subsection{Compiling static executable}
	This object handles the creation of a static executable which should
	contain a set of static process libraries.
	<<Compilations: public>>=
	public :: compilation_t
	<<Compilations: types>>=
	type :: compilation_t
	private
	type(string_t) :: exe_name
	type(string_t), dimension(:), allocatable :: lib_name
	contains
	<<Compilations: compilation: TBP>>
	end type compilation_t

	@ %def compilation_t
	@ Output.
	<<Compilations: compilation: TBP>>=
	procedure :: write => compilation_write
	<<Compilations: sub interfaces>>=
	module subroutine compilation_write (object, unit)
	class(compilation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine compilation_write
	<<Compilations: procedures>>=
	module subroutine compilation_write (object, unit)
	class(compilation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Compilation object:"
	write (u, "(3x,3A)") "executable = '", &
	char (object%exe_name), "'"
	write (u, "(3x,A)", advance="no") "process libraries ="
	do i = 1, size (object%lib_name)
	write (u, "(1x,3A)", advance="no") "'", char (object%lib_name(i)), "'"
	end do
	write (u, *)
	end subroutine compilation_write

	@ %def compilation_write
	@ Initialize: we know the names of the executable and of the libraries.
	Optionally, we may provide a workspace directory.
	<<Compilations: compilation: TBP>>=
	procedure :: init => compilation_init
	<<Compilations: sub interfaces>>=
	module subroutine compilation_init (compilation, exe_name, lib_name)
	class(compilation_t), intent(out) :: compilation
	type(string_t), intent(in) :: exe_name
	type(string_t), dimension(:), intent(in) :: lib_name
	end subroutine compilation_init
	<<Compilations: procedures>>=
	module subroutine compilation_init (compilation, exe_name, lib_name)
	class(compilation_t), intent(out) :: compilation
	type(string_t), intent(in) :: exe_name
	type(string_t), dimension(:), intent(in) :: lib_name
	compilation%exe_name = exe_name
	allocate (compilation%lib_name (size (lib_name)))
	compilation%lib_name = lib_name
	end subroutine compilation_init

	@ %def compilation_init
	@ Write the dispatcher subroutine for the compiled libraries. Also
	write a subroutine which returns the names of the compiled libraries.
	<<Compilations: compilation: TBP>>=
	procedure :: write_dispatcher => compilation_write_dispatcher
	<<Compilations: sub interfaces>>=
	module subroutine compilation_write_dispatcher (compilation)
	class(compilation_t), intent(in) :: compilation
	end subroutine compilation_write_dispatcher
	<<Compilations: procedures>>=
	module subroutine compilation_write_dispatcher (compilation)
	class(compilation_t), intent(in) :: compilation
	type(string_t) :: file
	integer :: u, i
	file = compilation%exe_name // "_prclib_dispatcher.f90"
	call msg_message ("Static executable '" // char (compilation%exe_name) &
	// "': writing library dispatcher")
	u = free_unit ()
	open (u, file = char (file), status="replace", action="write")
	write (u, "(3A)") "! Whizard: process libraries for executable '", &
	char (compilation%exe_name), "'"
	write (u, "(A)") "! Automatically generated file, do not edit"
	write (u, "(A)") "subroutine dispatch_prclib_static " // &
	"(driver, basename, modellibs_ldflags)"
	write (u, "(A)") " use iso_varying_string, string_t => varying_string"
	write (u, "(A)") " use prclib_interfaces"
	do i = 1, size (compilation%lib_name)
	associate (lib_name => compilation%lib_name(i))
	write (u, "(A)") " use " // char (lib_name) // "_driver"
	end associate
	end do
	write (u, "(A)") " implicit none"
	write (u, "(A)") " class(prclib_driver_t), intent(inout), allocatable &
	&:: driver"
	write (u, "(A)") " type(string_t), intent(in) :: basename"
	write (u, "(A)") " logical, intent(in), optional :: " // &
	"modellibs_ldflags"
	write (u, "(A)") " select case (char (basename))"
	do i = 1, size (compilation%lib_name)
	associate (lib_name => compilation%lib_name(i))
	write (u, "(3A)") " case ('", char (lib_name), "')"
	write (u, "(3A)") " allocate (", char (lib_name), "_driver_t &
	&:: driver)"
	end associate
	end do
	write (u, "(A)") " end select"
	write (u, "(A)") "end subroutine dispatch_prclib_static"
	write (u, *)
	write (u, "(A)") "subroutine get_prclib_static (libname)"
	write (u, "(A)") " use iso_varying_string, string_t => varying_string"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " type(string_t), dimension(:), intent(inout), &
	&allocatable :: libname"
	write (u, "(A,I0,A)") " allocate (libname (", &
	size (compilation%lib_name), "))"
	do i = 1, size (compilation%lib_name)
	associate (lib_name => compilation%lib_name(i))
	write (u, "(A,I0,A,A,A)") " libname(", i, ") = '", &
	char (lib_name), "'"
	end associate
	end do
	write (u, "(A)") "end subroutine get_prclib_static"
	close (u)
	end subroutine compilation_write_dispatcher

	@ %def compilation_write_dispatcher
	@ Write the Makefile subroutine for the compiled libraries.
	<<Compilations: compilation: TBP>>=
	procedure :: write_makefile => compilation_write_makefile
	<<Compilations: sub interfaces>>=
	module subroutine compilation_write_makefile &
	(compilation, os_data, ext_libtag, verbose, overwrite_os)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: overwrite_os
	type(string_t), intent(in), optional :: ext_libtag
	end subroutine compilation_write_makefile
	<<Compilations: procedures>>=
	module subroutine compilation_write_makefile &
	(compilation, os_data, ext_libtag, verbose, overwrite_os)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: overwrite_os
	type(string_t), intent(in), optional :: ext_libtag
	logical :: overwrite
	type(string_t) :: file, ext_tag
	integer :: u, i
	overwrite = .false.
	if (present (overwrite_os)) overwrite = overwrite_os
	if (present (ext_libtag)) then
	ext_tag = ext_libtag
	else
	ext_tag = ""
	end if
	file = compilation%exe_name // ".makefile"
	call msg_message ("Static executable '" // char (compilation%exe_name) &
	// "': writing makefile")
	u = free_unit ()
	open (u, file = char (file), status="replace", action="write")
	write (u, "(3A)") "# WHIZARD: Makefile for executable '", &
	char (compilation%exe_name), "'"
	write (u, "(A)") "# Automatically generated file, do not edit"
	write (u, "(A)") ""
	write (u, "(A)") "# Executable name"
	write (u, "(A)") "EXE = " // char (compilation%exe_name)
	write (u, "(A)") ""
	write (u, "(A)") "# Compiler"
	write (u, "(A)") "FC = " // char (os_data%fc)
	write (u, "(A)") "CXX = " // char (os_data%cxx)
	write (u, "(A)") ""
	write (u, "(A)") "# Included libraries"
	write (u, "(A)") "FCINCL = " // char (os_data%whizard_includes)
	write (u, "(A)") ""
	write (u, "(A)") "# Compiler flags"
	write (u, "(A)") "FCFLAGS = " // char (os_data%fcflags)
	write (u, "(A)") "FCLIBS = " // char (os_data%fclibs)
	write (u, "(A)") "CXXFLAGS = " // char (os_data%cxxflags)
	write (u, "(A)") "CXXLIBSS = " // char (os_data%cxxlibs)
	write (u, "(A)") "LDFLAGS = " // char (os_data%ldflags)
	write (u, "(A)") "LDFLAGS_STATIC = " // char (os_data%ldflags_static)
	write (u, "(A)") "LDFLAGS_HEPMC = " // char (os_data%ldflags_hepmc)
	write (u, "(A)") "LDFLAGS_LCIO = " // char (os_data%ldflags_lcio)
	write (u, "(A)") "LDFLAGS_HOPPET = " // char (os_data%ldflags_hoppet)
	write (u, "(A)") "LDFLAGS_LOOPTOOLS = " // char (os_data%ldflags_looptools)
	write (u, "(A)") "LDWHIZARD = " // char (os_data%whizard_ldflags)
	write (u, "(A)") ""
	write (u, "(A)") "# Libtool"
	write (u, "(A)") "LIBTOOL = " // char (os_data%whizard_libtool)
	if (verbose) then
	write (u, "(A)") "FCOMPILE = $(LIBTOOL) --tag=FC --mode=compile"
	if (OS_IS_DARWIN .and. .not. overwrite) then
	write (u, "(A)") "LINK = $(LIBTOOL) --tag=CXX --mode=link"
	else
	write (u, "(A)") "LINK = $(LIBTOOL) --tag=FC --mode=link"
	end if
	else
	write (u, "(A)") "FCOMPILE = @$(LIBTOOL) --silent --tag=FC --mode=compile"
	if (OS_IS_DARWIN .and. .not. overwrite) then
	write (u, "(A)") "LINK = @$(LIBTOOL) --silent --tag=CXX --mode=link"
	else
	write (u, "(A)") "LINK = @$(LIBTOOL) --silent --tag=FC --mode=link"
	end if
	end if
	write (u, "(A)") ""
	write (u, "(A)") "# Compile commands (default)"
	write (u, "(A)") "LTFCOMPILE = $(FCOMPILE) $(FC) -c $(FCINCL) $(FCFLAGS)"
	write (u, "(A)") ""
	write (u, "(A)") "# Default target"
	write (u, "(A)") "all: link"
	write (u, "(A)") ""
	write (u, "(A)") "# Libraries"
	do i = 1, size (compilation%lib_name)
	associate (lib_name => compilation%lib_name(i))
	write (u, "(A)") "LIBRARIES += " // char (lib_name) // ".la"
	write (u, "(A)") char (lib_name) // ".la:"
	write (u, "(A)") TAB // "$(MAKE) -f " // char (lib_name) // ".makefile"
	end associate
	end do
	write (u, "(A)") ""
	write (u, "(A)") "# Library dispatcher"
	write (u, "(A)") "DISP = $(EXE)_prclib_dispatcher"
	write (u, "(A)") "$(DISP).lo: $(DISP).f90 $(LIBRARIES)"
	if (.not. verbose) then
	write (u, "(A)") TAB // '@echo " FC " $@'
	end if
	write (u, "(A)") TAB // "$(LTFCOMPILE) $<"
	write (u, "(A)") ""
	write (u, "(A)") "# Executable"
	write (u, "(A)") "$(EXE): $(DISP).lo $(LIBRARIES)"
	if (.not. verbose) then
	if (OS_IS_DARWIN .and. .not. overwrite) then
	write (u, "(A)") TAB // '@echo " CXXLD " $@'
	else
	write (u, "(A)") TAB // '@echo " FCLD " $@'
	end if
	end if
	if (OS_IS_DARWIN .and. .not. overwrite) then
	write (u, "(A)") TAB // "$(LINK) $(CXX) -static $(CXXFLAGS) \"
	else
	write (u, "(A)") TAB // "$(LINK) $(FC) -static $(FCFLAGS) \"
	end if
	write (u, "(A)") TAB // " $(LDWHIZARD) $(LDFLAGS) \"
	write (u, "(A)") TAB // " -o $(EXE) $^ \"
	write (u, "(A)") TAB // " $(LDFLAGS_HEPMC) $(LDFLAGS_LCIO) $(LDFLAGS_HOPPET) \"
	if (OS_IS_DARWIN .and. .not. overwrite) then
	write (u, "(A)") TAB // " $(LDFLAGS_LOOPTOOLS) $(LDFLAGS_STATIC) \"
	write (u, "(A)") TAB // " $(CXXLIBS) $(FCLIBS)" // char (ext_tag)
	else
	write (u, "(A)") TAB // " $(LDFLAGS_LOOPTOOLS) $(LDFLAGS_STATIC)" // char (ext_tag)
	end if
	write (u, "(A)") ""
	write (u, "(A)") "# Main targets"
	write (u, "(A)") "link: compile $(EXE)"
	write (u, "(A)") "compile: $(LIBRARIES) $(DISP).lo"
	write (u, "(A)") ".PHONY: link compile"
	write (u, "(A)") ""
	write (u, "(A)") "# Cleanup targets"
	write (u, "(A)") "clean-exe:"
	write (u, "(A)") TAB // "rm -f $(EXE)"
	write (u, "(A)") "clean-objects:"
	write (u, "(A)") TAB // "rm -f $(DISP).lo"
	write (u, "(A)") "clean-source:"
	write (u, "(A)") TAB // "rm -f $(DISP).f90"
	write (u, "(A)") "clean-makefile:"
	write (u, "(A)") TAB // "rm -f $(EXE).makefile"
	write (u, "(A)") ""
	write (u, "(A)") "clean: clean-exe clean-objects clean-source"
	write (u, "(A)") "distclean: clean clean-makefile"
	write (u, "(A)") ".PHONY: clean distclean"
	close (u)
	end subroutine compilation_write_makefile

	@ %def compilation_write_makefile
	@ Compile the dispatcher source code.
	<<Compilations: compilation: TBP>>=
	procedure :: make_compile => compilation_make_compile
	<<Compilations: sub interfaces>>=
	module subroutine compilation_make_compile (compilation, os_data)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	end subroutine compilation_make_compile
	<<Compilations: procedures>>=
	module subroutine compilation_make_compile (compilation, os_data)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	call os_system_call ("make compile " // os_data%makeflags &
	// " -f " // compilation%exe_name // ".makefile")
	end subroutine compilation_make_compile

	@ %def compilation_make_compile
	@ Link the dispatcher together with all matrix-element code and the
	\whizard\ and \oMega\ main libraries, to generate a static executable.
	<<Compilations: compilation: TBP>>=
	procedure :: make_link => compilation_make_link
	<<Compilations: sub interfaces>>=
	module subroutine compilation_make_link (compilation, os_data)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	end subroutine compilation_make_link
	<<Compilations: procedures>>=
	module subroutine compilation_make_link (compilation, os_data)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	call os_system_call ("make link " // os_data%makeflags &
	// " -f " // compilation%exe_name // ".makefile")
	end subroutine compilation_make_link

	@ %def compilation_make_link
	@ Cleanup.
	<<Compilations: compilation: TBP>>=
	procedure :: make_clean_exe => compilation_make_clean_exe
	<<Compilations: sub interfaces>>=
	module subroutine compilation_make_clean_exe (compilation, os_data)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	end subroutine compilation_make_clean_exe
	<<Compilations: procedures>>=
	module subroutine compilation_make_clean_exe (compilation, os_data)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	call os_system_call ("make clean-exe " // os_data%makeflags &
	// " -f " // compilation%exe_name // ".makefile")
	end subroutine compilation_make_clean_exe

	@ %def compilation_make_clean_exe
	@
	\subsection{API for executable compilation}
	This is a shorthand for compiling and loading an executable, including
	the enclosed libraries. The [[compilation]] object is used only internally.

	The [[global]] data set may actually be local to the caller. The
	compilation affects the library specified by its name if it is on the
	stack, but it does not reset the currently selected library.
	<<Compilations: public>>=
	public :: compile_executable
	<<Compilations: sub interfaces>>=
	module subroutine compile_executable (exename, libname, global)
	type(string_t), intent(in) :: exename
	type(string_t), dimension(:), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: global
	end subroutine compile_executable
	<<Compilations: procedures>>=
	module subroutine compile_executable (exename, libname, global)
	type(string_t), intent(in) :: exename
	type(string_t), dimension(:), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: global
	type(compilation_t) :: compilation
	type(compilation_item_t) :: item
	type(string_t) :: ext_libtag
	logical :: force, recompile, verbose
	integer :: i
	ext_libtag = ""
	force = &
	global%var_list%get_lval (var_str ("?rebuild_library"))
	recompile = &
	global%var_list%get_lval (var_str ("?recompile_library"))
	verbose = &
	global%var_list%get_lval (var_str ("?me_verbose"))
	call compilation%init (exename, [libname])
	if (signal_is_pending ()) return
	call compilation%write_dispatcher ()
	if (signal_is_pending ()) return
	do i = 1, size (libname)
	call item%init (libname(i), global%prclib_stack, global%var_list)
	call item%compile (global%model, global%os_data, &
	force=force, recompile=recompile)
	ext_libtag = "" // item%lib%get_static_modelname (global%os_data)
	if (signal_is_pending ()) return
	call item%success ()
	end do
	call compilation%write_makefile &
	(global%os_data, ext_libtag=ext_libtag, verbose=verbose)
	if (signal_is_pending ()) return
	call compilation%make_compile (global%os_data)
	if (signal_is_pending ()) return
	call compilation%make_link (global%os_data)
	end subroutine compile_executable

	@ %def compile_executable
	@
	\subsection{Unit Tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[compilations_ut.f90]]>>=
	<<File header>>

	module compilations_ut
	use unit_tests
	use compilations_uti

	<<Standard module head>>

	<<Compilations: public test>>

	contains

	<<Compilations: test driver>>

	end module compilations_ut
	@ %def compilations_ut
	@
	<<[[compilations_uti.f90]]>>=
	<<File header>>

	module compilations_uti

	<<Use strings>>
	use io_units
	use models
	use rt_data
	use process_configurations_ut, only: prepare_test_library

	use compilations

	<<Standard module head>>

	<<Compilations: test declarations>>

	contains

	<<Compilations: tests>>

	end module compilations_uti

	@ %def compilations_uti
	@ API: driver for the unit tests below.
	<<Compilations: public test>>=
	public :: compilations_test
	<<Compilations: test driver>>=
	subroutine compilations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Compilations: execute tests>>
	end subroutine compilations_test

	@ %def compilations_test
	@
	\subsubsection{Intrinsic Matrix Element}
	Compile an intrinsic test matrix element ([[prc_test]] type).

	Note: In this and the following test, we reset the Fortran compiler and flag
	variables immediately before they are printed, so the test is portable.
	<<Compilations: execute tests>>=
	call test (compilations_1, "compilations_1", &
	"intrinsic test processes", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_1
	<<Compilations: tests>>=
	subroutine compilations_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: compilations_1"
	write (u, "(A)") "* Purpose: configure and compile test process"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	libname = "compilation_1"
	procname = "prc_comp_1"
	call prepare_test_library (global, libname, 1, [procname])

	call compile_library (libname, global)

	call global%write_libraries (u)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: compilations_1"

	end subroutine compilations_1

	@ %def compilations_1
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type)
	<<Compilations: execute tests>>=
	call test (compilations_2, "compilations_2", &
	"external process (omega)", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_2
	<<Compilations: tests>>=
	subroutine compilations_2 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: compilations_2"
	write (u, "(A)") "* Purpose: configure and compile test process"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilation_2"
	procname = "prc_comp_2"
	call prepare_test_library (global, libname, 2, [procname,procname])

	call compile_library (libname, global)

	call global%write_libraries (u, libpath = .false.)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: compilations_2"

	end subroutine compilations_2

	@ %def compilations_2
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type) and
	create driver files for a static executable.
	<<Compilations: execute tests>>=
	call test (compilations_3, "compilations_3", &
	"static executable: driver", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_3
	<<Compilations: tests>>=
	subroutine compilations_3 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname, exename
	type(rt_data_t), target :: global
	type(compilation_t) :: compilation
	integer :: u_file
	character(80) :: buffer

	write (u, "(A)") "* Test output: compilations_3"
	write (u, "(A)") "* Purpose: make static executable"
	write (u, "(A)")

	write (u, "(A)") "* Initialize library"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilations_3_lib"
	procname = "prc_comp_3"
	exename = "compilations_3"

	call prepare_test_library (global, libname, 2, [procname,procname])

	call compilation%init (exename, [libname])
	call compilation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write dispatcher"
	write (u, "(A)")

	call compilation%write_dispatcher ()

	u_file = free_unit ()
	open (u_file, file = char (exename) // "_prclib_dispatcher.f90", &
	status = "old", action = "read")
	do
	read (u_file, "(A)", end = 1) buffer
	write (u, "(A)") trim (buffer)
	end do
	1 close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Write Makefile"
	write (u, "(A)")

	associate (os_data => global%os_data)
	os_data%fc = "fortran-compiler"
	os_data%cxx = "c++-compiler"
	os_data%whizard_includes = "my-includes"
	os_data%fcflags = "my-fcflags"
	os_data%fclibs = "my-fclibs"
	os_data%cxxflags = "my-cxxflags"
	os_data%cxxlibs = "my-cxxlibs"
	os_data%ldflags = "my-ldflags"
	os_data%ldflags_static = "my-ldflags-static"
	os_data%ldflags_hepmc = "my-ldflags-hepmc"
	os_data%ldflags_lcio = "my-ldflags-lcio"
	os_data%ldflags_hoppet = "my-ldflags-hoppet"
	os_data%ldflags_looptools = "my-ldflags-looptools"
	os_data%whizard_ldflags = "my-ldwhizard"
	os_data%whizard_libtool = "my-libtool"
	end associate

	call compilation%write_makefile &
	(global%os_data, verbose = .true., overwrite_os = .true.)

	open (u_file, file = char (exename) // ".makefile", &
	status = "old", action = "read")
	do
	read (u_file, "(A)", end = 2) buffer
	write (u, "(A)") trim (buffer)
	end do
	2 close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: compilations_3"

	end subroutine compilations_3

	@ %def compilations_3
	@
	\subsection{Test static build}
	The tests for building a static executable are separate, since they
	should be skipped if the \whizard\ build itself has static libraries
	disabled.
	<<Compilations: public test>>=
	public :: compilations_static_test
	<<Compilations: test driver>>=
	subroutine compilations_static_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Compilations: static tests>>
	end subroutine compilations_static_test

	@ %def compilations_static_test
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type) and
	incorporate this in a new static WHIZARD executable.
	<<Compilations: static tests>>=
	call test (compilations_static_1, "compilations_static_1", &
	"static executable: compilation", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_static_1
	<<Compilations: tests>>=
	subroutine compilations_static_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname, exename
	type(rt_data_t), target :: global
	type(compilation_item_t) :: item
	type(compilation_t) :: compilation
	logical :: exist

	write (u, "(A)") "* Test output: compilations_static_1"
	write (u, "(A)") "* Purpose: make static executable"
	write (u, "(A)")

	write (u, "(A)") "* Initialize library"

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilations_static_1_lib"
	procname = "prc_comp_stat_1"
	exename = "compilations_static_1"

	call prepare_test_library (global, libname, 2, [procname,procname])

	call compilation%init (exename, [libname])

	write (u, "(A)")
	write (u, "(A)") "* Write dispatcher"

	call compilation%write_dispatcher ()

	write (u, "(A)")
	write (u, "(A)") "* Write Makefile"

	call compilation%write_makefile (global%os_data, verbose = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Build libraries"

	call item%init (libname, global%prclib_stack, global%var_list)
	call item%compile &
	(global%model, global%os_data, force=.true., recompile=.false.)
	call item%success ()

	write (u, "(A)")
	write (u, "(A)") "* Check executable (should be absent)"
	write (u, "(A)")

	call compilation%make_clean_exe (global%os_data)
	inquire (file = char (exename), exist = exist)
	write (u, "(A,A,L1)") char (exename), " exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Build executable"
	write (u, "(A)")

	call compilation%make_compile (global%os_data)
	call compilation%make_link (global%os_data)

	write (u, "(A)") "* Check executable (should be present)"
	write (u, "(A)")

	inquire (file = char (exename), exist = exist)
	write (u, "(A,A,L1)") char (exename), " exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call compilation%make_clean_exe (global%os_data)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: compilations_static_1"

	end subroutine compilations_static_1

	@ %def compilations_static_1
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type) and
	incorporate this in a new static WHIZARD executable. In this version,
	we use the wrapper [[compile_executable]] procedure.
	<<Compilations: static tests>>=
	call test (compilations_static_2, "compilations_static_2", &
	"static executable: shortcut", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_static_2
	<<Compilations: tests>>=
	subroutine compilations_static_2 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname, exename
	type(rt_data_t), target :: global
	logical :: exist
	integer :: u_file

	write (u, "(A)") "* Test output: compilations_static_2"
	write (u, "(A)") "* Purpose: make static executable"
	write (u, "(A)")

	write (u, "(A)") "* Initialize library and compile"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilations_static_2_lib"
	procname = "prc_comp_stat_2"
	exename = "compilations_static_2"

	call prepare_test_library (global, libname, 2, [procname,procname])

	call compile_executable (exename, [libname], global)

	write (u, "(A)") "* Check executable (should be present)"
	write (u, "(A)")

	inquire (file = char (exename), exist = exist)
	write (u, "(A,A,L1)") char (exename), " exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	u_file = free_unit ()
	open (u_file, file = char (exename), status = "old", action = "write")
	close (u_file, status = "delete")

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: compilations_static_2"

	end subroutine compilations_static_2

	@ %def compilations_static_2
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Integration}
	This module manages phase space setup, matrix-element evaluation and
	integration, as far as it is not done by lower-level routines, in particular
	in the [[processes]] module.
	<<[[integrations.f90]]>>=
	<<File header>>

	module integrations

	<<Use kinds>>
	<<Use strings>>
	<<Use debug>>
	use diagnostics
	use prc_core
	use process
	use instances
	use process_stacks
	use iterations
	use rt_data
	use nlo_data

	<<Standard module head>>

	<<Integrations: public>>

	<<Integrations: types>>

	interface
	<<Integrations: sub interfaces>>
	end interface

	contains

	<<Integrations: main procedures>>

	end module integrations
	@ %def integrations
	@
	<<[[integrations_sub.f90]]>>=
	<<File header>>

	submodule (integrations) integrations_s

	<<Use mpi f08>>
	use io_units
	use cputime
	use os_interface
	use physics_defs
	use model_data
	use pdg_arrays
	use variables, only: var_list_t
	use eval_trees
	use sf_mappings
	use sf_base
	use phs_base
	use models
	use dispatch_me_methods, only: dispatch_core
	use dispatch_beams, only: dispatch_qcd, sf_prop_t, dispatch_sf_config
	use dispatch_phase_space, only: dispatch_sf_channels
	use dispatch_phase_space, only: dispatch_phs
	use dispatch_mci, only: dispatch_mci_setup, setup_grid_path
	use dispatch_transforms, only: dispatch_evt_shower_hook
	use compilations, only: compile_library

	implicit none

	contains

	<<Integrations: procedures>>

	end submodule integrations_s

	@ %def integrations_s
	@
	\subsection{The integration type}
	This type holds all relevant data, the integration methods operates on this.
	In contrast to the [[simulation_t]] introduced later, the [[integration_t]]
	applies to a single process.
	<<Integrations: public>>=
	public :: integration_t
	<<Integrations: types>>=
	type :: integration_t
	private
	type(string_t) :: process_id
	type(string_t) :: run_id
	type(process_t), pointer :: process => null ()
	logical :: rebuild_phs = .false.
	logical :: ignore_phs_mismatch = .false.
	logical :: phs_only = .false.
	logical :: process_has_me = .true.
	integer :: n_calls_test = 0
	logical :: vis_history = .true.
	type(string_t) :: history_filename
	type(string_t) :: log_filename
	type(helicity_selection_t) :: helicity_selection
	logical :: use_color_factors = .false.
	logical :: has_beam_pol = .false.
	logical :: combined_integration = .false.
	type(iteration_multipliers_t) :: iteration_multipliers
	type(nlo_settings_t) :: nlo_settings
	contains
	<<Integrations: integration: TBP>>
	end type integration_t

	@ %def integration_t
	@
	@
	\subsection{Initialization}
	Initialization, first part: Create a process entry.
	Push it on the stack if the [[global]] environment is supplied.
	Gfortran7/8/9 bug, has to remain in the main module:
	<<Integrations: integration: TBP>>=
	procedure :: create_process => integration_create_process
	<<Integrations: main procedures>>=
	subroutine integration_create_process (intg, process_id, global)
	class(integration_t), intent(out) :: intg
	type(rt_data_t), intent(inout), optional, target :: global
	type(string_t), intent(in) :: process_id
	type(process_entry_t), pointer :: process_entry
	if (debug_on) call msg_debug (D_CORE, "integration_create_process")
	intg%process_id = process_id
	if (present (global)) then
	allocate (process_entry)
	intg%process => process_entry%process_t
	call global%process_stack%push (process_entry)
	else
	allocate (process_t :: intg%process)
	end if
	end subroutine integration_create_process

	@ %def integration_create_process
	@ Initialization, second part: Initialize the process object, using the local
	environment. We allocate a RNG factory and a QCD object.
	We also fetch a pointer to the model that the process uses. The
	process initializer will create a snapshot of that model.

	This procedure
	does not modify the [[local]] stack directly. The intent(inout) attribute for
	the [[local]] data set is due to the random generator seed which may be
	incremented during initialization.

	NOTE: Changes to model parameters within the current context are respected
	only if the process model coincides with the current model. This is the usual
	case. If not, we read
	the model from the global model library, which has default parameters. To
	become more flexible, we should implement a local model library which records
	local changes to currently inactive models.
	<<Integrations: integration: TBP>>=
	procedure :: init_process => integration_init_process
	<<Integrations: sub interfaces>>=
	module subroutine integration_init_process (intg, local)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(inout), target :: local
	end subroutine integration_init_process
	<<Integrations: procedures>>=
	module subroutine integration_init_process (intg, local)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(inout), target :: local
	type(string_t) :: model_name
	type(model_t), pointer :: model
	class(model_data_t), pointer :: model_instance
	type(var_list_t), pointer :: var_list
	if (debug_on) call msg_debug (D_CORE, "integration_init_process")
	if (.not. local%prclib%contains (intg%process_id)) then
	call msg_fatal ("Process '" // char (intg%process_id) // "' not found" &
	// " in library '" // char (local%prclib%get_name ()) // "'")
	return
	end if
	model_name = local%prclib%get_model_name (intg%process_id)
	if (local%get_sval (var_str ("$model_name")) == model_name) then
	model => local%model
	else
	model => local%model_list%get_model_ptr (model_name)
	end if
	var_list => local%get_var_list_ptr ()
	call intg%process%init (intg%process_id, &
	local%prclib, &
	local%os_data, &
	model, &
	var_list, &
	local%beam_structure)
	intg%run_id = intg%process%get_run_id ()
	end subroutine integration_init_process

	@ %def integration_init_process
	@ Initialization, third part: complete process configuration.
	<<Integrations: integration: TBP>>=
	procedure :: setup_process => integration_setup_process
	<<Integrations: sub interfaces>>=
	module subroutine integration_setup_process &
	(intg, local, verbose, init_only)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(inout), target :: local
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: init_only
	end subroutine integration_setup_process
	<<Integrations: procedures>>=
	module subroutine integration_setup_process (intg, local, verbose, init_only)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(inout), target :: local
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: init_only

	type(var_list_t), pointer :: var_list
	type(sf_config_t), dimension(:), allocatable :: sf_config
	type(sf_prop_t) :: sf_prop
	type(sf_channel_t), dimension(:), allocatable :: sf_channel
	type(phs_channel_collection_t) :: phs_channel_collection
	logical :: sf_trace
	logical :: verb, initialize_only
	type(string_t) :: sf_string
	type(string_t) :: workspace
	real(default) :: sqrts

	verb = .true.; if (present (verbose)) verb = verbose

	initialize_only = .false.
	if (present (init_only)) initialize_only = init_only

	call display_init_message (verb)

	var_list => local%get_var_list_ptr ()
	call setup_log_and_history ()

	associate (process => intg%process)
	call set_intg_parameters (process)

	call process%setup_cores (dispatch_core, &
	intg%helicity_selection, intg%use_color_factors, intg%has_beam_pol)

	call process%init_phs_config ()
	call process%init_components ()

	call process%record_inactive_components ()
	intg%process_has_me = process%has_matrix_element ()
	if (.not. intg%process_has_me) then
	call msg_warning ("Process '" &
	// char (intg%process_id) // "': matrix element vanishes")
	end if

	call setup_beams ()
	call setup_structure_functions ()

	workspace = var_list%get_sval (var_str ("$integrate_workspace"))
	if (workspace == "") then
	call process%configure_phs &
	(intg%rebuild_phs, &
	intg%ignore_phs_mismatch, &
	intg%combined_integration)
	else
	call setup_grid_path (workspace)
	call process%configure_phs &
	(intg%rebuild_phs, &
	intg%ignore_phs_mismatch, &
	intg%combined_integration, &
	workspace)
	end if

	call process%complete_pcm_setup ()

	call process%prepare_blha_cores ()
	call process%create_blha_interface ()
	call process%prepare_any_external_code ()

	call process%setup_terms (with_beams = intg%has_beam_pol)
	call process%check_masses ()
	call process%optimize_nlo_singular_regions ()

	if (verb) then
	call process%write (screen = .true.)
	call process%print_phs_startup_message ()
	end if

	if (intg%process_has_me) then
	if (size (sf_config) > 0) then
	call process%collect_channels (phs_channel_collection)
	else if (.not. initialize_only &
	.and. process%contains_trivial_component ()) then
	call msg_fatal ("Integrate: 2 -> 1 process can't be handled &
	&with fixed-energy beams")
	end if
	if (local%beam_structure%asymmetric ()) then
	sqrts = process%get_sqrts ()
	else
	sqrts = local%get_sqrts ()
	end if
	call dispatch_sf_channels &
	(sf_channel, sf_string, sf_prop, phs_channel_collection, &
	local%var_list, sqrts, local%beam_structure)
	if (allocated (sf_channel)) then
	if (size (sf_channel) > 0) then
	call process%set_sf_channel (sf_channel)
	end if
	end if
	call phs_channel_collection%final ()
	if (verb) call process%sf_startup_message (sf_string)
	end if

	call process%setup_mci (dispatch_mci_setup)

	call setup_expressions ()

	call process%compute_md5sum ()
	end associate

	contains

	subroutine setup_log_and_history ()
	if (intg%run_id /= "") then
	intg%history_filename = intg%process_id // "." // intg%run_id &
	// ".history"
	intg%log_filename = intg%process_id // "." // intg%run_id // ".log"
	else
	intg%history_filename = intg%process_id // ".history"
	intg%log_filename = intg%process_id // ".log"
	end if
	intg%vis_history = &
	var_list%get_lval (var_str ("?vis_history"))
	end subroutine setup_log_and_history

	subroutine set_intg_parameters (process)
	type(process_t), intent(in) :: process
	intg%n_calls_test = &
	var_list%get_ival (var_str ("n_calls_test"))
	intg%combined_integration = &
	var_list%get_lval (var_str ('?combined_nlo_integration')) &
	.and. process%is_nlo_calculation ()
	intg%use_color_factors = &
	var_list%get_lval (var_str ("?read_color_factors"))
	intg%has_beam_pol = &
	local%beam_structure%has_polarized_beams ()
	intg%helicity_selection = &
	local%get_helicity_selection ()
	intg%rebuild_phs = &
	var_list%get_lval (var_str ("?rebuild_phase_space"))
	intg%ignore_phs_mismatch = &
	.not. var_list%get_lval (var_str ("?check_phs_file"))
	intg%phs_only = &
	var_list%get_lval (var_str ("?phs_only"))
	end subroutine set_intg_parameters

	subroutine display_init_message (verb)
	logical, intent(in) :: verb
	if (verb) then
	call msg_message ("Initializing integration for process " &
	// char (intg%process_id) // ":")
	if (intg%run_id /= "") &
	call msg_message ("Run ID = " // '"' // char (intg%run_id) // '"')
	end if
	end subroutine display_init_message

	subroutine setup_beams ()
	real(default) :: sqrts
	logical :: decay_rest_frame
	sqrts = local%get_sqrts ()
	decay_rest_frame = &
	var_list%get_lval (var_str ("?decay_rest_frame"))
	if (intg%process_has_me) then
	call intg%process%setup_beams_beam_structure &
	(local%beam_structure, sqrts, decay_rest_frame)
	end if
	if (verb .and. intg%process_has_me) then
	call intg%process%beams_startup_message &
	(beam_structure = local%beam_structure)
	end if
	end subroutine setup_beams

	subroutine setup_structure_functions ()
	integer :: n_in
	type(pdg_array_t), dimension(:,:), allocatable :: pdg_prc
	type(string_t) :: sf_trace_file
	if (intg%process_has_me) then
	call intg%process%get_pdg_in (pdg_prc)
	else
	n_in = intg%process%get_n_in ()
	allocate (pdg_prc (n_in, intg%process%get_n_components ()))
	pdg_prc = 0
	end if
	call dispatch_sf_config (sf_config, sf_prop, local%beam_structure, &
	local%get_var_list_ptr (), local%var_list, &
	local%model, local%os_data, local%get_sqrts (), pdg_prc)

	sf_trace = &
	var_list%get_lval (var_str ("?sf_trace"))
	sf_trace_file = &
	var_list%get_sval (var_str ("$sf_trace_file"))
	if (sf_trace) then
	call intg%process%init_sf_chain (sf_config, sf_trace_file)
	else
	call intg%process%init_sf_chain (sf_config)
	end if
	end subroutine setup_structure_functions

	subroutine setup_expressions ()
	type(eval_tree_factory_t) :: expr_factory
	if (associated (local%pn%cuts_lexpr)) then
	if (verb) call msg_message ("Applying user-defined cuts.")
	call expr_factory%init (local%pn%cuts_lexpr)
	call intg%process%set_cuts (expr_factory)
	else
	if (verb) call msg_warning ("No cuts have been defined.")
	end if
	if (associated (local%pn%scale_expr)) then
	if (verb) call msg_message ("Using user-defined general scale.")
	call expr_factory%init (local%pn%scale_expr)
	call intg%process%set_scale (expr_factory)
	end if
	if (associated (local%pn%fac_scale_expr)) then
	if (verb) call msg_message ("Using user-defined factorization scale.")
	call expr_factory%init (local%pn%fac_scale_expr)
	call intg%process%set_fac_scale (expr_factory)
	end if
	if (associated (local%pn%ren_scale_expr)) then
	if (verb) call msg_message ("Using user-defined renormalization scale.")
	call expr_factory%init (local%pn%ren_scale_expr)
	call intg%process%set_ren_scale (expr_factory)
	end if
	if (associated (local%pn%weight_expr)) then
	if (verb) call msg_message ("Using user-defined reweighting factor.")
	call expr_factory%init (local%pn%weight_expr)
	call intg%process%set_weight (expr_factory)
	end if
	end subroutine setup_expressions
	end subroutine integration_setup_process

	@ %def integration_setup_process
	@
	\subsection{Integration}
	Integrate: do the final integration. Here, we do a multi-iteration
	integration. Again, we skip iterations that are already on file.
	Record the results in the global variable list.
	<<Integrations: integration: TBP>>=
	procedure :: evaluate => integration_evaluate
	<<Integrations: sub interfaces>>=
	module subroutine integration_evaluate &
	(intg, process_instance, i_mci, pass, it_list, pacify)
	class(integration_t), intent(inout) :: intg
	type(process_instance_t), intent(inout), target :: process_instance
	integer, intent(in) :: i_mci
	integer, intent(in) :: pass
	type(iterations_list_t), intent(in) :: it_list
	logical, intent(in), optional :: pacify
	end subroutine integration_evaluate
	<<Integrations: procedures>>=
	module subroutine integration_evaluate &
	(intg, process_instance, i_mci, pass, it_list, pacify)
	class(integration_t), intent(inout) :: intg
	type(process_instance_t), intent(inout), target :: process_instance
	integer, intent(in) :: i_mci
	integer, intent(in) :: pass
	type(iterations_list_t), intent(in) :: it_list
	logical, intent(in), optional :: pacify
	integer :: n_calls, n_it
	logical :: adapt_grids, adapt_weights, final
	n_it = it_list%get_n_it (pass)
	n_calls = it_list%get_n_calls (pass)
	adapt_grids = it_list%adapt_grids (pass)
	adapt_weights = it_list%adapt_weights (pass)
	final = pass == it_list%get_n_pass ()
	call process_instance%integrate ( &
	i_mci, n_it, n_calls, adapt_grids, adapt_weights, &
	final, pacify)
	end subroutine integration_evaluate

	@ %def integration_evaluate
	@ In case the user has not provided a list of iterations, make a
	reasonable default. This can depend on the process. The usual
	approach is to define two distinct passes, one for adaptation and one
	for integration.
	<<Integrations: integration: TBP>>=
	procedure :: make_iterations_list => integration_make_iterations_list
	<<Integrations: sub interfaces>>=
	module subroutine integration_make_iterations_list (intg, it_list)
	class(integration_t), intent(in) :: intg
	type(iterations_list_t), intent(out) :: it_list
	end subroutine integration_make_iterations_list
	<<Integrations: procedures>>=
	module subroutine integration_make_iterations_list (intg, it_list)
	class(integration_t), intent(in) :: intg
	type(iterations_list_t), intent(out) :: it_list
	integer :: pass, n_pass
	integer, dimension(:), allocatable :: n_it, n_calls
	logical, dimension(:), allocatable :: adapt_grids, adapt_weights
	n_pass = intg%process%get_n_pass_default ()
	allocate (n_it (n_pass), n_calls (n_pass))
	allocate (adapt_grids (n_pass), adapt_weights (n_pass))
	do pass = 1, n_pass
	n_it(pass) = intg%process%get_n_it_default (pass)
	n_calls(pass) = intg%process%get_n_calls_default (pass)
	adapt_grids(pass) = intg%process%adapt_grids_default (pass)
	adapt_weights(pass) = intg%process%adapt_weights_default (pass)
	end do
	call it_list%init (n_it, n_calls, &
	adapt_grids = adapt_grids, adapt_weights = adapt_weights)
	end subroutine integration_make_iterations_list

	@ %def integration_make_iterations_list
	@ In NLO calculations, the individual components might scale very differently
	with the number of calls. This especially applies to the real-subtracted
	component, which usually fluctuates more than the Born and virtual
	component, making it a bottleneck of the calculation. Thus, the calculation
	is throttled twice, first by the number of calls for the real component,
	second by the number of surplus calls of computation-intense virtual
	matrix elements. Therefore, we want to set a different number of calls
	for each component, which is done by the subroutine [[integration_apply_call_multipliers]].
	<<Integrations: integration: TBP>>=
	procedure :: init_iteration_multipliers => &
	integration_init_iteration_multipliers
	<<Integrations: sub interfaces>>=
	module subroutine integration_init_iteration_multipliers (intg, local)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(in) :: local
	end subroutine integration_init_iteration_multipliers
	<<Integrations: procedures>>=
	module subroutine integration_init_iteration_multipliers (intg, local)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(in) :: local
	integer :: n_pass, pass
	type(iterations_list_t) :: it_list
	n_pass = local%it_list%get_n_pass ()
	if (n_pass == 0) then
	call intg%make_iterations_list (it_list)
	n_pass = it_list%get_n_pass ()
	end if
	associate (it_multipliers => intg%iteration_multipliers)
	allocate (it_multipliers%n_calls0 (n_pass))
	do pass = 1, n_pass
	it_multipliers%n_calls0(pass) = local%it_list%get_n_calls (pass)
	end do
	it_multipliers%mult_real = local%var_list%get_rval &
	(var_str ("mult_call_real"))
	it_multipliers%mult_virt = local%var_list%get_rval &
	(var_str ("mult_call_virt"))
	it_multipliers%mult_dglap = local%var_list%get_rval &
	(var_str ("mult_call_dglap"))
	end associate
	end subroutine integration_init_iteration_multipliers

	@ %def integration_init_iteration_multipliers
	@
	<<Integrations: integration: TBP>>=
	procedure :: apply_call_multipliers => integration_apply_call_multipliers
	<<Integrations: sub interfaces>>=
	module subroutine integration_apply_call_multipliers &
	(intg, n_pass, i_component, it_list)
	class(integration_t), intent(in) :: intg
	integer, intent(in) :: n_pass, i_component
	type(iterations_list_t), intent(inout) :: it_list
	end subroutine integration_apply_call_multipliers
	<<Integrations: procedures>>=
	module subroutine integration_apply_call_multipliers &
	(intg, n_pass, i_component, it_list)
	class(integration_t), intent(in) :: intg
	integer, intent(in) :: n_pass, i_component
	type(iterations_list_t), intent(inout) :: it_list
	integer :: nlo_type
	integer :: n_calls0, n_calls
	integer :: pass
	real(default) :: multiplier
	nlo_type = intg%process%get_component_nlo_type (i_component)
	do pass = 1, n_pass
	associate (multipliers => intg%iteration_multipliers)
	select case (nlo_type)
	case (NLO_REAL)
	multiplier = multipliers%mult_real
	case (NLO_VIRTUAL)
	multiplier = multipliers%mult_virt
	case (NLO_DGLAP)
	multiplier = multipliers%mult_dglap
	case default
	return
	end select
	end associate
	if (n_pass <= size (intg%iteration_multipliers%n_calls0)) then
	n_calls0 = intg%iteration_multipliers%n_calls0 (pass)
	n_calls = floor (multiplier * n_calls0)
	call it_list%set_n_calls (pass, n_calls)
	end if
	end do
	end subroutine integration_apply_call_multipliers

	@ %def integration_apply_call_multipliers
	@
	\subsection{API for integration objects}
	This initializer does everything except assigning cuts/scale/weight
	expressions.
	<<Integrations: integration: TBP>>=
	procedure :: init => integration_init
	<<Integrations: sub interfaces>>=
	module subroutine integration_init &
	(intg, process_id, local, global, local_stack, init_only)
	class(integration_t), intent(out) :: intg
	type(string_t), intent(in) :: process_id
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	logical, intent(in), optional :: init_only
	logical, intent(in), optional :: local_stack
	end subroutine integration_init
	<<Integrations: procedures>>=
	module subroutine integration_init &
	(intg, process_id, local, global, local_stack, init_only)
	class(integration_t), intent(out) :: intg
	type(string_t), intent(in) :: process_id
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	logical, intent(in), optional :: init_only
	logical, intent(in), optional :: local_stack
	logical :: use_local
	use_local = .false.; if (present (local_stack)) use_local = local_stack
	if (present (global)) then
	call intg%create_process (process_id, global)
	else if (use_local) then
	call intg%create_process (process_id, local)
	else
	call intg%create_process (process_id)
	end if
	call intg%init_process (local)
	call intg%setup_process (local, init_only = init_only)
	call intg%init_iteration_multipliers (local)
	end subroutine integration_init

	@ %def integration_init
	@ Do the integration for a single process, both warmup and final evaluation.
	The [[eff_reset]] flag is to suppress numerical noise in the graphical output
	of the integration history.
	<<Integrations: integration: TBP>>=
	procedure :: integrate => integration_integrate
	<<Integrations: sub interfaces>>=
	module subroutine integration_integrate (intg, local, eff_reset)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(in), target :: local
	logical, intent(in), optional :: eff_reset
	end subroutine integration_integrate
	<<Integrations: procedures>>=
	module subroutine integration_integrate (intg, local, eff_reset)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(in), target :: local
	logical, intent(in), optional :: eff_reset
	type(string_t) :: log_filename
	type(var_list_t), pointer :: var_list
	type(process_instance_t), allocatable, target :: process_instance
	type(iterations_list_t) :: it_list
	logical :: pacify
	integer :: pass, i_mci, n_mci, n_pass
	integer :: i_component
	integer :: nlo_type
	logical :: display_summed
	logical :: nlo_active
	type(string_t) :: component_output

	allocate (process_instance)
	call process_instance%init (intg%process)

	var_list => intg%process%get_var_list_ptr ()
	call openmp_set_num_threads_verbose &
	(var_list%get_ival (var_str ("openmp_num_threads")), &
	var_list%get_lval (var_str ("?openmp_logging")))
	pacify = var_list%get_lval (var_str ("?pacify"))

	display_summed = .true.
	n_mci = intg%process%get_n_mci ()
	if (n_mci == 1) then
	write (msg_buffer, "(A,A,A)") &
	"Starting integration for process '", &
	char (intg%process%get_id ()), "'"
	call msg_message ()
	end if

	call setup_hooks ()

	nlo_active = any (intg%process%get_component_nlo_type &
	([(i_mci, i_mci = 1, n_mci)]) /= BORN)
	do i_mci = 1, n_mci
	i_component = intg%process%get_master_component (i_mci)
	nlo_type = intg%process%get_component_nlo_type (i_component)
	if (intg%process%component_can_be_integrated (i_component)) then
	if (n_mci > 1) then
	if (nlo_active) then
	if (intg%combined_integration .and. nlo_type == BORN) then
	component_output = var_str ("Combined")
	else
	component_output = component_status (nlo_type)
	end if
	write (msg_buffer, "(A,A,A,A,A)") &
	"Starting integration for process '", &
	char (intg%process%get_id ()), "' part '", &
	char (component_output), "'"
	else
	write (msg_buffer, "(A,A,A,I0)") &
	"Starting integration for process '", &
	char (intg%process%get_id ()), "' part ", i_mci
	end if
	call msg_message ()
	end if
	n_pass = local%it_list%get_n_pass ()
	if (n_pass == 0) then
	call msg_message ("Integrate: iterations not specified, &
	&using default")
	call intg%make_iterations_list (it_list)
	n_pass = it_list%get_n_pass ()
	else
	it_list = local%it_list
	end if
	call intg%apply_call_multipliers (n_pass, i_mci, it_list)
	call msg_message ("Integrate: " // char (it_list%to_string ()))
	do pass = 1, n_pass
	call intg%evaluate (process_instance, i_mci, pass, it_list, pacify)
	if (signal_is_pending ()) return
	end do
	call intg%process%final_integration (i_mci)
	if (intg%vis_history) then
	call intg%process%display_integration_history &
	(i_mci, intg%history_filename, local%os_data, eff_reset)
	end if
	if (local%logfile == intg%log_filename) then
	if (intg%run_id /= "") then
	log_filename = intg%process_id // "." // intg%run_id // &
	".var.log"
	else
	log_filename = intg%process_id // ".var.log"
	end if
	call msg_message ("Name clash for global logfile and process log: ", &
	arr =[var_str ("\| Renaming log file from ") // local%logfile, &
	var_str ("\| to ") // log_filename // var_str (" .")])
	else
	log_filename = intg%log_filename
	end if
	call intg%process%write_logfile (i_mci, log_filename)
	end if
	end do

	if (n_mci > 1 .and. display_summed) then
	call msg_message ("Integrate: sum of all components")
	call intg%process%display_summed_results (pacify)
	end if

	call process_instance%final ()
	deallocate (process_instance)
	contains
	subroutine setup_hooks ()
	class(process_instance_hook_t), pointer :: hook
	call dispatch_evt_shower_hook (hook, var_list, process_instance, &
	local%beam_structure, intg%process%get_pdf_set())
	if (associated (hook)) then
	call process_instance%append_after_hook (hook)
	end if
	end subroutine setup_hooks
	end subroutine integration_integrate

	@ %def integration_integrate
	@ Do a dummy integration for a process which could not be initialized (e.g.,
	has no matrix element). The result is zero.
	<<Integrations: integration: TBP>>=
	procedure :: integrate_dummy => integration_integrate_dummy
	<<Integrations: sub interfaces>>=
	module subroutine integration_integrate_dummy (intg)
	class(integration_t), intent(inout) :: intg
	end subroutine integration_integrate_dummy
	<<Integrations: procedures>>=
	module subroutine integration_integrate_dummy (intg)
	class(integration_t), intent(inout) :: intg
	call intg%process%integrate_dummy ()
	end subroutine integration_integrate_dummy

	@ %def integration_integrate_dummy
	@ Just sample the matrix element under realistic conditions (but no
	cuts); throw away the results.
	<<Integrations: integration: TBP>>=
	procedure :: sampler_test => integration_sampler_test
	<<Integrations: sub interfaces>>=
	module subroutine integration_sampler_test (intg)
	class(integration_t), intent(inout) :: intg
	end subroutine integration_sampler_test
	<<Integrations: procedures>>=
	module subroutine integration_sampler_test (intg)
	class(integration_t), intent(inout) :: intg
	type(process_instance_t), allocatable, target :: process_instance
	integer :: n_mci, i_mci
	type(timer_t) :: timer_mci, timer_tot
	real(default) :: t_mci, t_tot
	allocate (process_instance)
	call process_instance%init (intg%process)
	n_mci = intg%process%get_n_mci ()
	if (n_mci == 1) then
	write (msg_buffer, "(A,A,A)") &
	"Test: probing process '", &
	char (intg%process%get_id ()), "'"
	call msg_message ()
	end if
	call timer_tot%start ()
	do i_mci = 1, n_mci
	if (n_mci > 1) then
	write (msg_buffer, "(A,A,A,I0)") &
	"Test: probing process '", &
	char (intg%process%get_id ()), "' part ", i_mci
	call msg_message ()
	end if
	call timer_mci%start ()
	call process_instance%sampler_test (i_mci, intg%n_calls_test)
	call timer_mci%stop ()
	t_mci = timer_mci
	write (msg_buffer, "(A,ES12.5)") "Test: " &
	// "time in seconds (wallclock): ", t_mci
	call msg_message ()
	end do
	call timer_tot%stop ()
	t_tot = timer_tot
	if (n_mci > 1) then
	write (msg_buffer, "(A,ES12.5)") "Test: " &
	// "total time (wallclock): ", t_tot
	call msg_message ()
	end if
	call process_instance%final ()
	end subroutine integration_sampler_test

	@ %def integration_sampler_test
	@ Return the process pointer (needed by simulate):
	<<Integrations: integration: TBP>>=
	procedure :: get_process_ptr => integration_get_process_ptr
	<<Integrations: sub interfaces>>=
	module function integration_get_process_ptr (intg) result (ptr)
	class(integration_t), intent(in) :: intg
	type(process_t), pointer :: ptr
	end function integration_get_process_ptr
	<<Integrations: procedures>>=
	module function integration_get_process_ptr (intg) result (ptr)
	class(integration_t), intent(in) :: intg
	type(process_t), pointer :: ptr
	ptr => intg%process
	end function integration_get_process_ptr

	@ %def integration_get_process_ptr
	@ Simply integrate, do a dummy integration if necessary. The [[integration]]
	object exists only internally.

	If the [[global]] environment is provided, the process object is appended to
	the global stack. Otherwise, if [[local_stack]] is set, we append to the
	local process stack. If this is unset, the [[process]] object is not recorded
	permanently.

	The [[init_only]] flag can be used to skip the actual integration part. We
	will end up with a process object that is completely initialized, including
	phase space configuration.

	The [[eff_reset]] flag is to suppress numerical noise in the visualization
	of the integration history.
	<<Integrations: public>>=
	public :: integrate_process
	<<Integrations: sub interfaces>>=
	module subroutine integrate_process &
	(process_id, local, global, local_stack, init_only, eff_reset)
	type(string_t), intent(in) :: process_id
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	logical, intent(in), optional :: local_stack, init_only, eff_reset
	end subroutine integrate_process
	<<Integrations: procedures>>=
	module subroutine integrate_process &
	(process_id, local, global, local_stack, init_only, eff_reset)
	type(string_t), intent(in) :: process_id
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	logical, intent(in), optional :: local_stack, init_only, eff_reset
	type(string_t) :: prclib_name
	type(integration_t) :: intg
	character(32) :: buffer
	<<Integrations: integrate process: variables>>
	<<Integrations: integrate process: init>>
	if (.not. associated (local%prclib)) then
	call msg_fatal ("Integrate: current process library is undefined")
	return
	end if

	if (.not. local%prclib%is_active ()) then
	call msg_message ("Integrate: current process library needs compilation")
	prclib_name = local%prclib%get_name ()
	call compile_library (prclib_name, local)
	if (signal_is_pending ()) return
	call msg_message ("Integrate: compilation done")
	end if

	call intg%init (process_id, local, global, local_stack, init_only)
	if (signal_is_pending ()) return

	if (present (init_only)) then
	if (init_only) return
	end if

	if (intg%n_calls_test > 0) then
	write (buffer, "(I0)") intg%n_calls_test
	call msg_message ("Integrate: test (" // trim (buffer) // " calls) ...")
	call intg%sampler_test ()
	call msg_message ("Integrate: ... test complete.")
	if (signal_is_pending ()) return
	end if
	<<Integrations: integrate process: end init>>

	if (intg%phs_only) then
	call msg_message ("Integrate: phase space only, skipping integration")
	else
	if (intg%process_has_me) then
	call intg%integrate (local, eff_reset)
	else
	call intg%integrate_dummy ()
	end if
	end if
	end subroutine integrate_process

	@ %def integrate_process
	<<Integrations: integrate process: variables>>=
	@
	<<Integrations: integrate process: init>>=
	@
	<<Integrations: integrate process: end init>>=
	@
	@ The parallelization leads to undefined behavior while writing simultaneously to one file.
	The master worker has to initialize single-handed the corresponding library files and the phase space file.
	The slave worker will wait with a blocking [[MPI_BCAST]] until they receive a logical flag.
	<<MPI: Integrations: integrate process: variables>>=
	type(var_list_t), pointer :: var_list
	logical :: mpi_logging, process_init
	integer :: rank, n_size
	<<MPI: Integrations: integrate process: init>>=
	if (debug_on) call msg_debug (D_MPI, "integrate_process")
	var_list => local%get_var_list_ptr ()
	process_init = .false.
	call mpi_get_comm_id (n_size, rank)
	mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) .and. &
	& (n_size > 1)) .or. var_list%get_lval (var_str ("?mpi_logging")))
	if (debug_on) call msg_debug (D_MPI, "n_size", rank)
	if (debug_on) call msg_debug (D_MPI, "rank", rank)
	if (debug_on) call msg_debug (D_MPI, "mpi_logging", mpi_logging)
	if (rank /= 0) then
	if (mpi_logging) then
	call msg_message ("MPI: wait for master to finish process initialization ...")
	end if
	call MPI_bcast (process_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
	else
	process_init = .true.
	end if

	if (process_init) then
	<<MPI: Integrations: integrate process: end init>>=
	if (rank == 0) then
	if (mpi_logging) then
	call msg_message ("MPI: finish process initialization, load slaves ...")
	end if
	call MPI_bcast (process_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
	end if
	end if
	call MPI_barrier (MPI_COMM_WORLD)
	call mpi_set_logging (mpi_logging)
	@ %def integrate_process_mpi
	@
	\subsection{Unit Tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[integrations_ut.f90]]>>=
	<<File header>>

	module integrations_ut
	use unit_tests
	use integrations_uti

	<<Standard module head>>

	<<Integrations: public test>>

	contains

	<<Integrations: test driver>>

	end module integrations_ut
	@ %def integrations_ut
	@
	<<[[integrations_uti.f90]]>>=
	<<File header>>

	module integrations_uti

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use ifiles
	use lexers
	use parser
	use flavors
	use interactions, only: reset_interaction_counter
	use phs_forests
	use eval_trees
	use models
	use rt_data
	use process_configurations_ut, only: prepare_test_library
	use compilations, only: compile_library

	use integrations

	use phs_wood_ut, only: write_test_phs_file

	<<Standard module head>>

	<<Integrations: test declarations>>

	contains

	<<Integrations: tests>>

	end module integrations_uti

	@ %def integrations_uti
	@ API: driver for the unit tests below.
	<<Integrations: public test>>=
	public :: integrations_test
	<<Integrations: test driver>>=
	subroutine integrations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Integrations: execute tests>>
	end subroutine integrations_test

	@ %def integrations_test
	@
	<<Integrations: public test>>=
	public :: integrations_history_test
	<<Integrations: test driver>>=
	subroutine integrations_history_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Integrations: execute history tests>>
	end subroutine integrations_history_test

	@ %def integrations_history_test
	@
	\subsubsection{Integration of test process}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type). The phase-space implementation is [[phs_single]]
	(single-particle phase space), the integrator is [[mci_midpoint]].

	The cross section for the $2\to 2$ process $ss\to ss$ with its
	constant matrix element is given by
	\begin{equation}
	\sigma = c\times f\times \Phi_2 \times \|M\|^2.
	\end{equation}
	$c$ is the conversion constant
	\begin{equation}
	c = 0.3894\times 10^{12}\;\mathrm{fb}\,\mathrm{GeV}^2.
	\end{equation}
	$f$ is the flux of the incoming particles with mass
	$m=125\,\mathrm{GeV}$ and energy $\sqrt{s}=1000\,\mathrm{GeV}$
	\begin{equation}
	f = \frac{(2\pi)^4}{2\lambda^{1/2}(s,m^2,m^2)}
	= \frac{(2\pi)^4}{2\sqrt{s}\,\sqrt{s - 4m^2}}
	= 8.048\times 10^{-4}\;\mathrm{GeV}^{-2}
	\end{equation}
	$\Phi_2$ is the volume of the two-particle phase space
	\begin{equation}
	\Phi_2 = \frac{1}{4(2\pi)^5} = 2.5529\times 10^{-5}.
	\end{equation}
	The squared matrix element $\|M\|^2$ is unity.
	Combining everything, we obtain
	\begin{equation}
	\sigma = 8000\;\mathrm{fb}
	\end{equation}
	This number should appear as the final result.

	Note: In this and the following test, we reset the Fortran compiler and flag
	variables immediately before they are printed, so the test is portable.
	<<Integrations: execute tests>>=
	call test (integrations_1, "integrations_1", &
	"intrinsic test process", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_1
	<<Integrations: tests>>=
	subroutine integrations_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: integrations_1"
	write (u, "(A)") "* Purpose: integrate test process"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	libname = "integration_1"
	procname = "prc_config_a"

	call prepare_test_library (global, libname, 1)
	call compile_library (libname, global)

	call global%set_string (var_str ("$run_id"), &
	var_str ("integrations1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = [ &
	var_str ("$method"), &
	var_str ("sqrts"), &
	var_str ("$integration_method"), &
	var_str ("$phs_method"), &
	var_str ("$run_id")])

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_1"

	end subroutine integrations_1

	@ %def integrations_1
	@
	\subsubsection{Integration with cuts}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) with cuts set.
	<<Integrations: execute tests>>=
	call test (integrations_2, "integrations_2", &
	"intrinsic test process with cut", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_2
	<<Integrations: tests>>=
	subroutine integrations_2 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	type(string_t) :: cut_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree

	type(string_t), dimension(0) :: empty_string_array

	write (u, "(A)") "* Test output: integrations_2"
	write (u, "(A)") "* Purpose: integrate test process with cut"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	write (u, "(A)") "* Prepare a cut expression"
	write (u, "(A)")

	call syntax_pexpr_init ()
	cut_expr_text = "all Pt > 100 [s]"
	call ifile_append (ifile, cut_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (parse_tree, stream, .true.)
	global%pn%cuts_lexpr => parse_tree%get_root_ptr ()

	write (u, "(A)") "* Build and initialize a test process"
	write (u, "(A)")

	libname = "integration_3"
	procname = "prc_config_a"

	call prepare_test_library (global, libname, 1)
	call compile_library (libname, global)

	call global%set_string (var_str ("$run_id"), &
	var_str ("integrations1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = empty_string_array)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_2"

	end subroutine integrations_2

	@ %def integrations_2
	@
	\subsubsection{Standard phase space}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the default ([[phs_wood]]) phase-space implementation. We
	use an explicit phase-space configuration file with a single channel
	and integrate by [[mci_midpoint]].
	<<Integrations: execute tests>>=
	call test (integrations_3, "integrations_3", &
	"standard phase space", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_3
	<<Integrations: tests>>=
	subroutine integrations_3 (u)
	<<Use kinds>>
	<<Use strings>>
	use interactions, only: reset_interaction_counter
	use models
	use rt_data
	use process_configurations_ut, only: prepare_test_library
	use compilations, only: compile_library
	use integrations

	implicit none

	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	integer :: u_phs

	write (u, "(A)") "* Test output: integrations_3"
	write (u, "(A)") "* Purpose: integrate test process"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()

	libname = "integration_3"
	procname = "prc_config_a"

	call prepare_test_library (global, libname, 1)
	call compile_library (libname, global)

	call global%set_string (var_str ("$run_id"), &
	var_str ("integrations1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("default"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?phs_s_mapping"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	write (u, "(A)") "* Create a scratch phase-space file"
	write (u, "(A)")

	u_phs = free_unit ()
	open (u_phs, file = "integrations_3.phs", &
	status = "replace", action = "write")
	call write_test_phs_file (u_phs, var_str ("prc_config_a_i1"))
	close (u_phs)

	call global%set_string (var_str ("$phs_file"),&
	var_str ("integrations_3.phs"), is_known = .true.)

	call global%it_list%init ([1], [1000])

	write (u, "(A)") "* Integrate"
	write (u, "(A)")

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = [ &
	var_str ("$phs_method"), &
	var_str ("$phs_file")])

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_3"

	end subroutine integrations_3

	@ %def integrations_3
	@
	\subsubsection{VAMP integration}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the single-channel ([[phs_single]]) phase-space
	implementation. The integration method is [[vamp]].
	<<Integrations: execute tests>>=
	call test (integrations_4, "integrations_4", &
	"VAMP integration (one iteration)", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_4
	<<Integrations: tests>>=
	subroutine integrations_4 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: integrations_4"
	write (u, "(A)") "* Purpose: integrate test process using VAMP"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	libname = "integrations_4_lib"
	procname = "integrations_4"

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	write (u, "(A)") "* Integrate"
	write (u, "(A)")

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%pacify (efficiency_reset = .true., error_reset = .true.)
	call global%write (u, vars = [var_str ("$integration_method")], &
	pacify = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_4"

	end subroutine integrations_4

	@ %def integrations_4
	@
	\subsubsection{Multiple iterations integration}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the single-channel ([[phs_single]]) phase-space
	implementation. The integration method is [[vamp]]. We launch three
	iterations.
	<<Integrations: execute tests>>=
	call test (integrations_5, "integrations_5", &
	"VAMP integration (three iterations)", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_5
	<<Integrations: tests>>=
	subroutine integrations_5 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: integrations_5"
	write (u, "(A)") "* Purpose: integrate test process using VAMP"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	libname = "integrations_5_lib"
	procname = "integrations_5"

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([3], [1000])

	write (u, "(A)") "* Integrate"
	write (u, "(A)")

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%pacify (efficiency_reset = .true., error_reset = .true.)
	call global%write (u, vars = [var_str ("$integration_method")], &
	pacify = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_5"

	end subroutine integrations_5

	@ %def integrations_5
	@
	\subsubsection{Multiple passes integration}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the single-channel ([[phs_single]]) phase-space
	implementation. The integration method is [[vamp]]. We launch three
	passes with three iterations each.
	<<Integrations: execute tests>>=
	call test (integrations_6, "integrations_6", &
	"VAMP integration (three passes)", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_6
	<<Integrations: tests>>=
	subroutine integrations_6 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: no_vars

	write (u, "(A)") "* Test output: integrations_6"
	write (u, "(A)") "* Purpose: integrate test process using VAMP"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	libname = "integrations_6_lib"
	procname = "integrations_6"

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([3, 3, 3], [1000, 1000, 1000], &
	adapt = [.true., .true., .false.], &
	adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])

	write (u, "(A)") "* Integrate"
	write (u, "(A)")

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%pacify (efficiency_reset = .true., error_reset = .true.)
	call global%write (u, vars = no_vars, pacify = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_6"

	end subroutine integrations_6

	@ %def integrations_6
	@
	\subsubsection{VAMP and default phase space}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the default ([[phs_wood]]) phase-space
	implementation. The integration method is [[vamp]]. We launch three
	passes with three iterations each. We enable channel equivalences and
	groves.
	<<Integrations: execute tests>>=
	call test (integrations_7, "integrations_7", &
	"VAMP integration with wood phase space", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_7
	<<Integrations: tests>>=
	subroutine integrations_7 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: no_vars
	integer :: iostat, u_phs
	character(95) :: buffer
	type(string_t) :: phs_file
	logical :: exist

	write (u, "(A)") "* Test output: integrations_7"
	write (u, "(A)") "* Purpose: integrate test process using VAMP"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()

	libname = "integrations_7_lib"
	procname = "integrations_7"

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?phs_s_mapping"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([3, 3, 3], [1000, 1000, 1000], &
	adapt = [.true., .true., .false.], &
	adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])

	write (u, "(A)") "* Integrate"
	write (u, "(A)")

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%pacify (efficiency_reset = .true., error_reset = .true.)
	call global%write (u, vars = no_vars, pacify = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Generated phase-space file"
	write (u, "(A)")

	phs_file = procname // ".r1.i1.phs"
	inquire (file = char (phs_file), exist = exist)
	if (exist) then
	u_phs = free_unit ()
	open (u_phs, file = char (phs_file), action = "read", status = "old")
	iostat = 0
	do while (iostat == 0)
	read (u_phs, "(A)", iostat = iostat) buffer
	if (iostat == 0) write (u, "(A)") trim (buffer)
	end do
	close (u_phs)
	else
	write (u, "(A)") "[file is missing]"
	end if

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_7"

	end subroutine integrations_7

	@ %def integrations_7
	@
	\subsubsection{Structure functions}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the default ([[phs_wood]]) phase-space
	implementation. The integration method is [[vamp]]. There is a structure
	function of type [[unit_test]].

	We use a test structure function $f(x)=x$ for both beams. Together with the
	$1/x_1x_2$ factor from the phase-space flux and a unit matrix element, we
	should get the same result as previously for the process without structure
	functions. There is a slight correction due to the $m_s$ mass which we set to
	zero here.
	<<Integrations: execute tests>>=
	call test (integrations_8, "integrations_8", &
	"integration with structure function", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_8
	<<Integrations: tests>>=
	subroutine integrations_8 (u)
	<<Use kinds>>
	<<Use strings>>
	use interactions, only: reset_interaction_counter
	use phs_forests
	use models
	use rt_data
	use process_configurations_ut, only: prepare_test_library
	use compilations, only: compile_library
	use integrations

	implicit none

	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	type(flavor_t) :: flv
	type(string_t) :: name

	write (u, "(A)") "* Test output: integrations_8"
	write (u, "(A)") "* Purpose: integrate test process using VAMP &
	&with structure function"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()

	libname = "integrations_8_lib"
	procname = "integrations_8"

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?phs_s_mapping"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), 0._default)

	call reset_interaction_counter ()

	call flv%init (25, global%model)

	name = flv%get_name ()
	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

	write (u, "(A)") "* Integrate"
	write (u, "(A)")

	call global%it_list%init ([1], [1000])
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = [var_str ("ms")])

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_8"

	end subroutine integrations_8

	@ %def integrations_8
	@
	\subsubsection{Integration with sign change}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type). The phase-space implementation is [[phs_single]]
	(single-particle phase space), the integrator is [[mci_midpoint]].
	The weight that is applied changes the sign in half of phase space.
	The weight is $-3$ and $1$, respectively, so the total result is equal
	to the original, but negative sign.

	The efficiency should (approximately) become the average of $1$ and
	$1/3$, that is $2/3$.
	<<Integrations: execute tests>>=
	call test (integrations_9, "integrations_9", &
	"handle sign change", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_9
	<<Integrations: tests>>=
	subroutine integrations_9 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	type(string_t) :: wgt_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree

	write (u, "(A)") "* Test output: integrations_9"
	write (u, "(A)") "* Purpose: integrate test process"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	write (u, "(A)") "* Prepare a weight expression"
	write (u, "(A)")

	call syntax_pexpr_init ()
	wgt_expr_text = "eval 2 * sgn (Pz) - 1 [s]"
	call ifile_append (ifile, wgt_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (parse_tree, stream, .true.)
	global%pn%weight_expr => parse_tree%get_root_ptr ()

	write (u, "(A)") "* Build and evaluate a test process"
	write (u, "(A)")

	libname = "integration_9"
	procname = "prc_config_a"

	call prepare_test_library (global, libname, 1)
	call compile_library (libname, global)

	call global%set_string (var_str ("$run_id"), &
	var_str ("integrations1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = [ &
	var_str ("$method"), &
	var_str ("sqrts"), &
	var_str ("$integration_method"), &
	var_str ("$phs_method"), &
	var_str ("$run_id")])

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_9"

	end subroutine integrations_9

	@ %def integrations_9
	@
	\subsubsection{Integration history for VAMP integration with default
	phase space}
	This test is only run when event analysis can be done.
	<<Integrations: execute history tests>>=
	call test (integrations_history_1, "integrations_history_1", &
	"Test integration history files", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_history_1
	<<Integrations: tests>>=
	subroutine integrations_history_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: no_vars
	integer :: iostat, u_his
	character(91) :: buffer
	type(string_t) :: his_file, ps_file, pdf_file
	logical :: exist, exist_ps, exist_pdf

	write (u, "(A)") "* Test output: integrations_history_1"
	write (u, "(A)") "* Purpose: test integration history files"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()

	libname = "integrations_history_1_lib"
	procname = "integrations_history_1"

	call global%set_log (var_str ("?vis_history"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?phs_s_mapping"),&
	.false., is_known = .true.)

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_real (var_str ("error_threshold"),&
	5E-6_default, is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([2, 2, 2], [1000, 1000, 1000], &
	adapt = [.true., .true., .false.], &
	adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])

	write (u, "(A)") "* Integrate"
	write (u, "(A)")

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true., &
	eff_reset = .true.)

	call global%pacify (efficiency_reset = .true., error_reset = .true.)
	call global%write (u, vars = no_vars, pacify = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Generated history files"
	write (u, "(A)")

	his_file = procname // ".r1.history.tex"
	ps_file = procname // ".r1.history.ps"
	pdf_file = procname // ".r1.history.pdf"
	inquire (file = char (his_file), exist = exist)
	if (exist) then
	u_his = free_unit ()
	open (u_his, file = char (his_file), action = "read", status = "old")
	iostat = 0
	do while (iostat == 0)
	read (u_his, "(A)", iostat = iostat) buffer
	if (iostat == 0) write (u, "(A)") trim (buffer)
	end do
	close (u_his)
	else
	write (u, "(A)") "[History LaTeX file is missing]"
	end if
	inquire (file = char (ps_file), exist = exist_ps)
	if (exist_ps) then
	write (u, "(A)") "[History Postscript file exists and is nonempty]"
	else
	write (u, "(A)") "[History Postscript file is missing/non-regular]"
	end if
	inquire (file = char (pdf_file), exist = exist_pdf)
	if (exist_pdf) then
	write (u, "(A)") "[History PDF file exists and is nonempty]"
	else
	write (u, "(A)") "[History PDF file is missing/non-regular]"
	end if

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_history_1"

	end subroutine integrations_history_1

	@ %def integrations_history_1
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Event Streams}
	This module manages I/O from/to multiple concurrent event streams.
	Usually, there is at most one input stream, but several output
	streams. For the latter, we set up an array which can hold [[eio_t]]
	(event I/O) objects of different dynamic types simultaneously. One of
	them may be marked as an input channel.
	<<[[event_streams.f90]]>>=
	<<File header>>

	module event_streams

	<<Use strings>>
	use events
	use event_handles, only: event_handle_t
	use eio_data
	use eio_base
	use rt_data

	use dispatch_transforms, only: dispatch_eio

	<<Standard module head>>

	<<Event streams: public>>

	<<Event streams: types>>

	interface
	<<Event streams: sub interfaces>>
	end interface

	end module event_streams
	@ %def event_streams
	@
	<<[[event_streams_sub.f90]]>>=
	<<File header>>

	submodule (event_streams) event_streams_s

	use io_units
	use diagnostics
	!!! Intel oneAPI 2022/23 regression workaround
	use event_handles, only: event_handle_t

	implicit none

	contains

	<<Event streams: procedures>>

	end submodule event_streams_s

	@ %def event_streams_s
	@
	\subsection{Event Stream Array}
	Each entry is an [[eio_t]] object. Since the type is dynamic, we need
	a wrapper:
	<<Event streams: types>>=
	type :: event_stream_entry_t
	class(eio_t), allocatable :: eio
	end type event_stream_entry_t

	@ %def event_stream_entry_t
	@ An array of event-stream entry objects. If one of the entries is an
	input channel, [[i_in]] is the corresponding index.
	<<Event streams: public>>=
	public :: event_stream_array_t
	<<Event streams: types>>=
	type :: event_stream_array_t
	type(event_stream_entry_t), dimension(:), allocatable :: entry
	integer :: i_in = 0
	contains
	<<Event streams: event stream array: TBP>>
	end type event_stream_array_t

	@ %def event_stream_array_t
	@ Output.
	<<Event streams: event stream array: TBP>>=
	procedure :: write => event_stream_array_write
	<<Event streams: sub interfaces>>=
	module subroutine event_stream_array_write (object, unit)
	class(event_stream_array_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine event_stream_array_write
	<<Event streams: procedures>>=
	module subroutine event_stream_array_write (object, unit)
	class(event_stream_array_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event stream array:"
	if (allocated (object%entry)) then
	select case (size (object%entry))
	case (0)
	write (u, "(3x,A)") "[empty]"
	case default
	do i = 1, size (object%entry)
	if (i == object%i_in) write (u, "(1x,A)") "Input stream:"
	call object%entry(i)%eio%write (u)
	end do
	end select
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine event_stream_array_write

	@ %def event_stream_array_write
	@ Check if there is content.
	<<Event streams: event stream array: TBP>>=
	procedure :: is_valid => event_stream_array_is_valid
	<<Event streams: sub interfaces>>=
	module function event_stream_array_is_valid (es_array) result (flag)
	class(event_stream_array_t), intent(in) :: es_array
	logical :: flag
	end function event_stream_array_is_valid
	<<Event streams: procedures>>=
	module function event_stream_array_is_valid (es_array) result (flag)
	class(event_stream_array_t), intent(in) :: es_array
	logical :: flag

	flag = allocated (es_array%entry)

	end function event_stream_array_is_valid

	@ %def event_stream_array_is_valid
	@ Finalize all streams.
	<<Event streams: event stream array: TBP>>=
	procedure :: final => event_stream_array_final
	<<Event streams: sub interfaces>>=
	module subroutine event_stream_array_final (es_array)
	class(event_stream_array_t), intent(inout) :: es_array
	end subroutine event_stream_array_final
	<<Event streams: procedures>>=
	module subroutine event_stream_array_final (es_array)
	class(event_stream_array_t), intent(inout) :: es_array
	integer :: i
	if (allocated (es_array%entry)) then
	do i = 1, size (es_array%entry)
	call es_array%entry(i)%eio%final ()
	end do
	end if
	end subroutine event_stream_array_final

	@ %def event_stream_array_final
	@ Initialization. We use a generic [[sample]] name, open event I/O
	objects for all provided stream types (using the [[dispatch_eio]]
	routine), and initialize for the given list of process pointers. If
	there is an [[input]] argument, this channel is initialized as an input
	channel and appended to the array.

	The [[input_data]] or, if not present, [[data]] may be modified. This
	happens if we open a stream for reading and get new information there.
	<<Event streams: event stream array: TBP>>=
	procedure :: init => event_stream_array_init
	<<Event streams: sub interfaces>>=
	module subroutine event_stream_array_init &
	(es_array, sample, stream_fmt, global, &
	data, input, input_sample, input_data, allow_switch, &
	checkpoint, callback, &
	error)
	class(event_stream_array_t), intent(out) :: es_array
	type(string_t), intent(in) :: sample
	type(string_t), dimension(:), intent(in) :: stream_fmt
	type(rt_data_t), intent(in) :: global
	type(event_sample_data_t), intent(inout), optional :: data
	type(string_t), intent(in), optional :: input
	type(string_t), intent(in), optional :: input_sample
	type(event_sample_data_t), intent(inout), optional :: input_data
	logical, intent(in), optional :: allow_switch
	integer, intent(in), optional :: checkpoint
	integer, intent(in), optional :: callback
	logical, intent(out), optional :: error
	end subroutine event_stream_array_init
	<<Event streams: procedures>>=
	module subroutine event_stream_array_init &
	(es_array, sample, stream_fmt, global, &
	data, input, input_sample, input_data, allow_switch, &
	checkpoint, callback, &
	error)
	class(event_stream_array_t), intent(out) :: es_array
	type(string_t), intent(in) :: sample
	type(string_t), dimension(:), intent(in) :: stream_fmt
	type(rt_data_t), intent(in) :: global
	type(event_sample_data_t), intent(inout), optional :: data
	type(string_t), intent(in), optional :: input
	type(string_t), intent(in), optional :: input_sample
	type(event_sample_data_t), intent(inout), optional :: input_data
	logical, intent(in), optional :: allow_switch
	integer, intent(in), optional :: checkpoint
	integer, intent(in), optional :: callback
	logical, intent(out), optional :: error
	type(string_t) :: sample_in
	integer :: n, i, n_output, i_input, i_checkpoint, i_callback
	logical :: success, switch
	if (present (input_sample)) then
	sample_in = input_sample
	else
	sample_in = sample
	end if
	if (present (allow_switch)) then
	switch = allow_switch
	else
	switch = .true.
	end if
	if (present (error)) then
	error = .false.
	end if
	n = size (stream_fmt)
	n_output = n
	if (present (input)) then
	n = n + 1
	i_input = n
	else
	i_input = 0
	end if
	if (present (checkpoint)) then
	n = n + 1
	i_checkpoint = n
	else
	i_checkpoint = 0
	end if
	if (present (callback)) then
	n = n + 1
	i_callback = n
	else
	i_callback = 0
	end if
	allocate (es_array%entry (n))
	if (i_checkpoint > 0) then
	call dispatch_eio &
	(es_array%entry(i_checkpoint)%eio, var_str ("checkpoint"), &
	global%var_list, global%fallback_model, &
	global%event_callback)
	call es_array%entry(i_checkpoint)%eio%init_out (sample, data)
	end if
	if (i_callback > 0) then
	call dispatch_eio &
	(es_array%entry(i_callback)%eio, var_str ("callback"), &
	global%var_list, global%fallback_model, &
	global%event_callback)
	call es_array%entry(i_callback)%eio%init_out (sample, data)
	end if
	if (i_input > 0) then
	call dispatch_eio (es_array%entry(i_input)%eio, input, &
	global%var_list, global%fallback_model, &
	global%event_callback)
	if (present (input_data)) then
	call es_array%entry(i_input)%eio%init_in &
	(sample_in, input_data, success)
	else
	call es_array%entry(i_input)%eio%init_in &
	(sample_in, data, success)
	end if
	if (success) then
	es_array%i_in = i_input
	else if (present (input_sample)) then
	if (present (error)) then
	error = .true.
	else
	call msg_fatal ("Events: &
	&parameter mismatch in input, aborting")
	end if
	else
	call msg_message ("Events: &
	&parameter mismatch, discarding old event set")
	call es_array%entry(i_input)%eio%final ()
	if (switch) then
	call msg_message ("Events: generating new events")
	call es_array%entry(i_input)%eio%init_out (sample, data)
	end if
	end if
	end if
	do i = 1, n_output
	call dispatch_eio (es_array%entry(i)%eio, stream_fmt(i), &
	global%var_list, global%fallback_model, &
	global%event_callback)
	call es_array%entry(i)%eio%init_out (sample, data)
	end do
	end subroutine event_stream_array_init

	@ %def event_stream_array_init
	@ Switch the (only) input channel to an output channel, so further
	events are appended to the respective stream.
	<<Event streams: event stream array: TBP>>=
	procedure :: switch_inout => event_stream_array_switch_inout
	<<Event streams: sub interfaces>>=
	module subroutine event_stream_array_switch_inout (es_array)
	class(event_stream_array_t), intent(inout) :: es_array
	end subroutine event_stream_array_switch_inout
	<<Event streams: procedures>>=
	module subroutine event_stream_array_switch_inout (es_array)
	class(event_stream_array_t), intent(inout) :: es_array
	integer :: n
	if (es_array%has_input ()) then
	n = es_array%i_in
	call es_array%entry(n)%eio%switch_inout ()
	es_array%i_in = 0
	else
	call msg_bug ("Reading events: switch_inout: no input stream selected")
	end if
	end subroutine event_stream_array_switch_inout

	@ %def event_stream_array_switch_inout
	@ Output an event (with given process number) to all output streams.
	If there is no output stream, do nothing.
	<<Event streams: event stream array: TBP>>=
	procedure :: output => event_stream_array_output
	<<Event streams: sub interfaces>>=
	module subroutine event_stream_array_output &
	(es_array, event, i_prc, event_index, passed, pacify, event_handle)
	class(event_stream_array_t), intent(inout) :: es_array
	type(event_t), intent(in), target :: event
	integer, intent(in) :: i_prc, event_index
	logical, intent(in), optional :: passed, pacify
	class(event_handle_t), intent(inout), optional :: event_handle
	end subroutine event_stream_array_output
	<<Event streams: procedures>>=
	module subroutine event_stream_array_output &
	(es_array, event, i_prc, event_index, passed, pacify, event_handle)
	class(event_stream_array_t), intent(inout) :: es_array
	type(event_t), intent(in), target :: event
	integer, intent(in) :: i_prc, event_index
	logical, intent(in), optional :: passed, pacify
	class(event_handle_t), intent(inout), optional :: event_handle
	logical :: increased
	integer :: i
	do i = 1, size (es_array%entry)
	if (i /= es_array%i_in) then
	associate (eio => es_array%entry(i)%eio)
	if (eio%split) then
	if (eio%split_n_evt > 0 .and. event_index > 1) then
	if (mod (event_index, eio%split_n_evt) == 1) then
	call eio%split_out ()
	end if
	else if (eio%split_n_kbytes > 0) then
	call eio%update_split_count (increased)
	if (increased) call eio%split_out ()
	end if
	end if
	call eio%output (event, i_prc, reading = es_array%i_in /= 0, &
	passed = passed, &
	pacify = pacify, &
	event_handle = event_handle)
	end associate
	end if
	end do
	end subroutine event_stream_array_output

	@ %def event_stream_array_output
	@ Input the [[i_prc]] index which selects the process for the current
	event. This is separated from reading the event, because it
	determines which event record to read. [[iostat]] may indicate an
	error or an EOF condition, as usual.
	<<Event streams: event stream array: TBP>>=
	procedure :: input_i_prc => event_stream_array_input_i_prc
	<<Event streams: sub interfaces>>=
	module subroutine event_stream_array_input_i_prc (es_array, i_prc, iostat)
	class(event_stream_array_t), intent(inout) :: es_array
	integer, intent(out) :: i_prc
	integer, intent(out) :: iostat
	end subroutine event_stream_array_input_i_prc
	<<Event streams: procedures>>=
	module subroutine event_stream_array_input_i_prc (es_array, i_prc, iostat)
	class(event_stream_array_t), intent(inout) :: es_array
	integer, intent(out) :: i_prc
	integer, intent(out) :: iostat
	integer :: n
	if (es_array%has_input ()) then
	n = es_array%i_in
	call es_array%entry(n)%eio%input_i_prc (i_prc, iostat)
	else
	call msg_fatal ("Reading events: no input stream selected")
	end if
	end subroutine event_stream_array_input_i_prc

	@ %def event_stream_array_input_i_prc
	@ Input an event from the selected input stream. [[iostat]] may indicate an
	error or an EOF condition, as usual.
	<<Event streams: event stream array: TBP>>=
	procedure :: input_event => event_stream_array_input_event
	<<Event streams: sub interfaces>>=
	module subroutine event_stream_array_input_event &
	(es_array, event, iostat, event_handle)
	class(event_stream_array_t), intent(inout) :: es_array
	type(event_t), intent(inout), target :: event
	integer, intent(out) :: iostat
	class(event_handle_t), intent(inout), optional :: event_handle
	end subroutine event_stream_array_input_event
	<<Event streams: procedures>>=
	module subroutine event_stream_array_input_event &
	(es_array, event, iostat, event_handle)
	class(event_stream_array_t), intent(inout) :: es_array
	type(event_t), intent(inout), target :: event
	integer, intent(out) :: iostat
	class(event_handle_t), intent(inout), optional :: event_handle
	integer :: n
	if (es_array%has_input ()) then
	n = es_array%i_in
	call es_array%entry(n)%eio%input_event (event, iostat, event_handle)
	else
	call msg_fatal ("Reading events: no input stream selected")
	end if
	end subroutine event_stream_array_input_event

	@ %def event_stream_array_input_event
	@ Skip an entry of eio\_t. Used to synchronize the event read-in for
	NLO events.
	<<Event streams: event stream array: TBP>>=
	procedure :: skip_eio_entry => event_stream_array_skip_eio_entry
	<<Event streams: sub interfaces>>=
	module subroutine event_stream_array_skip_eio_entry (es_array, iostat)
	class(event_stream_array_t), intent(inout) :: es_array
	integer, intent(out) :: iostat
	end subroutine event_stream_array_skip_eio_entry
	<<Event streams: procedures>>=
	module subroutine event_stream_array_skip_eio_entry (es_array, iostat)
	class(event_stream_array_t), intent(inout) :: es_array
	integer, intent(out) :: iostat
	integer :: n
	if (es_array%has_input ()) then
	n = es_array%i_in
	call es_array%entry(n)%eio%skip (iostat)
	else
	call msg_fatal ("Reading events: no input stream selected")
	end if
	end subroutine event_stream_array_skip_eio_entry

	@ %def event_stream_array_skip_eio_entry
	@ Return true if there is an input channel among the event streams.
	<<Event streams: event stream array: TBP>>=
	procedure :: has_input => event_stream_array_has_input
	<<Event streams: sub interfaces>>=
	module function event_stream_array_has_input (es_array) result (flag)
	class(event_stream_array_t), intent(in) :: es_array
	logical :: flag
	end function event_stream_array_has_input
	<<Event streams: procedures>>=
	module function event_stream_array_has_input (es_array) result (flag)
	class(event_stream_array_t), intent(in) :: es_array
	logical :: flag
	flag = es_array%i_in /= 0
	end function event_stream_array_has_input

	@ %def event_stream_array_has_input
	@
	\subsection{Unit Tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[event_streams_ut.f90]]>>=
	<<File header>>

	module event_streams_ut
	use unit_tests
	use event_streams_uti

	<<Standard module head>>

	<<Event streams: public test>>

	contains

	<<Event streams: test driver>>

	end module event_streams_ut
	@
	<<[[event_streams_uti.f90]]>>=
	<<File header>>

	module event_streams_uti

	<<Use kinds>>
	<<Use strings>>
	use model_data
	use eio_data
	use process, only: process_t
	use instances, only: process_instance_t
	use models
	use rt_data
	use events

	use event_streams

	<<Standard module head>>

	<<Event streams: test declarations>>

	contains

	<<Event streams: tests>>

	end module event_streams_uti

	@ %def event_streams_uti
	@ API: driver for the unit tests below.
	<<Event streams: public test>>=
	public :: event_streams_test
	<<Event streams: test driver>>=
	subroutine event_streams_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Event streams: execute tests>>
	end subroutine event_streams_test

	@ %def event_streams_test
	@
	\subsubsection{Empty event stream}
	This should set up an empty event output stream array, including
	initialization, output, and finalization (which are all no-ops).
	<<Event streams: execute tests>>=
	call test (event_streams_1, "event_streams_1", &
	"empty event stream array", &
	u, results)
	<<Event streams: test declarations>>=
	public :: event_streams_1
	<<Event streams: tests>>=
	subroutine event_streams_1 (u)
	integer, intent(in) :: u
	type(event_stream_array_t) :: es_array
	type(rt_data_t) :: global
	type(event_t) :: event
	type(string_t) :: sample
	type(string_t), dimension(0) :: empty_string_array

	write (u, "(A)") "* Test output: event_streams_1"
	write (u, "(A)") "* Purpose: handle empty event stream array"
	write (u, "(A)")

	sample = "event_streams_1"

	call es_array%init (sample, empty_string_array, global)
	call es_array%output (event, 42, 1)
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: event_streams_1"

	end subroutine event_streams_1

	@ %def event_streams_1
	@
	\subsubsection{Nontrivial event stream}
	Here we generate a trivial event and choose [[raw]] output as an entry in
	the stream array.
	<<Event streams: execute tests>>=
	call test (event_streams_2, "event_streams_2", &
	"nontrivial event stream array", &
	u, results)
	<<Event streams: test declarations>>=
	public :: event_streams_2
	<<Event streams: tests>>=
	subroutine event_streams_2 (u)
	use processes_ut, only: prepare_test_process
	integer, intent(in) :: u
	type(event_stream_array_t) :: es_array
	type(rt_data_t) :: global
	type(model_data_t), target :: model
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(string_t) :: sample
	type(string_t), dimension(0) :: empty_string_array
	integer :: i_prc, iostat

	write (u, "(A)") "* Test output: event_streams_2"
	write (u, "(A)") "* Purpose: handle empty event stream array"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call model%init_test ()

	write (u, "(A)") "* Generate test process event"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model, &
	run_id = var_str ("run_test"))
	call process_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())
	call event%generate (1, [0.4_default, 0.4_default])
	call event%set_index (42)
	call event%evaluate_expressions ()
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate raw eio stream and write event to file"
	write (u, "(A)")

	sample = "event_streams_2"

	call es_array%init (sample, [var_str ("raw")], global)
	call es_array%output (event, 1, 1)
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	sample = "foo"
	call es_array%init (sample, empty_string_array, global, &
	input = var_str ("raw"), input_sample = var_str ("event_streams_2"))
	call es_array%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reread event"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)

	write (u, "(1x,A,I0)") "i_prc = ", i_prc
	write (u, "(A)")
	call es_array%input_event (event, iostat)
	call es_array%final ()

	call event%write (u)

	call global%final ()

	call model%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: event_streams_2"

	end subroutine event_streams_2

	@ %def event_streams_2
	@
	\subsubsection{Switch in/out}
	Here we generate an event file and test switching from writing to
	reading when the file is exhausted.
	<<Event streams: execute tests>>=
	call test (event_streams_3, "event_streams_3", &
	"switch input/output", &
	u, results)
	<<Event streams: test declarations>>=
	public :: event_streams_3
	<<Event streams: tests>>=
	subroutine event_streams_3 (u)
	use processes_ut, only: prepare_test_process
	integer, intent(in) :: u
	type(event_stream_array_t) :: es_array
	type(rt_data_t) :: global
	type(model_data_t), target :: model
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(string_t) :: sample
	type(string_t), dimension(0) :: empty_string_array
	integer :: i_prc, iostat

	write (u, "(A)") "* Test output: event_streams_3"
	write (u, "(A)") "* Purpose: handle in/out switching"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call model%init_test ()

	write (u, "(A)") "* Generate test process event"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model, &
	run_id = var_str ("run_test"))
	call process_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())
	call event%generate (1, [0.4_default, 0.4_default])
	call event%increment_index ()
	call event%evaluate_expressions ()

	write (u, "(A)") "* Allocate raw eio stream and write event to file"
	write (u, "(A)")

	sample = "event_streams_3"

	call es_array%init (sample, [var_str ("raw")], global)
	call es_array%output (event, 1, 1)
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	call es_array%init (sample, empty_string_array, global, &
	input = var_str ("raw"))
	call es_array%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reread event"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)
	call es_array%input_event (event, iostat)

	write (u, "(A)") "* Attempt to read another event (fail), then generate"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)
	if (iostat < 0) then
	call es_array%switch_inout ()
	call event%generate (1, [0.3_default, 0.3_default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call es_array%output (event, 1, 2)
	end if
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	call es_array%init (sample, empty_string_array, global, &
	input = var_str ("raw"))
	call es_array%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reread two events and display 2nd event"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)
	call es_array%input_event (event, iostat)
	call es_array%input_i_prc (i_prc, iostat)

	call es_array%input_event (event, iostat)
	call es_array%final ()

	call event%write (u)

	call global%final ()

	call model%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: event_streams_3"

	end subroutine event_streams_3

	@ %def event_streams_3
	@
	\subsubsection{Checksum}
	Here we generate an event file and repeat twice, once with identical
	parameters and once with modified parameters.
	<<Event streams: execute tests>>=
	call test (event_streams_4, "event_streams_4", &
	"check MD5 sum", &
	u, results)
	<<Event streams: test declarations>>=
	public :: event_streams_4
	<<Event streams: tests>>=
	subroutine event_streams_4 (u)
	integer, intent(in) :: u
	type(event_stream_array_t) :: es_array
	type(rt_data_t) :: global
	type(process_t), allocatable, target :: process
	type(string_t) :: sample
	type(string_t), dimension(0) :: empty_string_array
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: event_streams_4"
	write (u, "(A)") "* Purpose: handle in/out switching"
	write (u, "(A)")

	write (u, "(A)") "* Generate test process event"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%set_log (var_str ("?check_event_file"), &
	.true., is_known = .true.)

	allocate (process)

	write (u, "(A)") "* Allocate raw eio stream for writing"
	write (u, "(A)")

	sample = "event_streams_4"
	data%md5sum_cfg = "1234567890abcdef1234567890abcdef"

	call es_array%init (sample, [var_str ("raw")], global, data)
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	call es_array%init (sample, empty_string_array, global, &
	data, input = var_str ("raw"))
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate modified raw eio stream for reading (fail)"
	write (u, "(A)")

	data%md5sum_cfg = "1234567890______1234567890______"
	call es_array%init (sample, empty_string_array, global, &
	data, input = var_str ("raw"))
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Repeat ignoring checksum"
	write (u, "(A)")

	call global%set_log (var_str ("?check_event_file"), &
	.false., is_known = .true.)
	call es_array%init (sample, empty_string_array, global, &
	data, input = var_str ("raw"))
	call es_array%write (u)
	call es_array%final ()

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: event_streams_4"

	end subroutine event_streams_4

	@ %def event_streams_4
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Restricted Subprocesses}
	This module provides an automatic means to construct restricted subprocesses
	of a current process object. A restricted subprocess has the same initial and
	final state as the current process, but a restricted set of Feynman graphs.

	The actual application extracts the set of resonance histories that apply to
	the process and uses this to construct subprocesses that are restricted to one
	of those histories, respectively. The resonance histories are derived from
	the phase-space setup. This implies that the method is tied to the OMega
	matrix element generator and to the wood phase space method.

	The processes are collected in a new process library that is generated
	on-the-fly.

	The [[resonant_subprocess_t]] object is intended as a component of the event
	record, which manages all operations regarding resonance handling.

	The run-time calculations are delegated to an event transform
	([[evt_resonance_t]]), as a part of the event transform chain. The transform
	selects one (or none) of the resonance histories, given the momentum
	configuration, computes matrix elements and inserts resonances into the
	particle set.
	<<[[restricted_subprocesses.f90]]>>=
	<<File header>>

	module restricted_subprocesses

	<<Use kinds>>
	<<Use strings>>
	use particle_specifiers, only: prt_spec_t
	use resonances, only: resonance_history_t, resonance_history_set_t
	use variables, only: var_list_t
	use models, only: model_t
	use event_transforms, only: evt_t
	use resonance_insertion, only: evt_resonance_t
	use rt_data, only: rt_data_t
	use process_configurations, only: process_configuration_t
	use process, only: process_t, process_ptr_t
	use instances, only: process_instance_t, process_instance_ptr_t

	<<Standard module head>>

	<<Restricted subprocesses: public>>

	<<Restricted subprocesses: types>>

	<<Restricted subprocesses: interfaces>>

	interface
	<<Restricted subprocesses: sub interfaces>>
	end interface

	end module restricted_subprocesses
	@ %def restricted_subprocesses
	@
	<<[[restricted_subprocesses_sub.f90]]>>=
	<<File header>>

	submodule (restricted_subprocesses) restricted_subprocesses_s

	use diagnostics, only: msg_message, msg_fatal, msg_bug
	use diagnostics, only: signal_is_pending
	use io_units, only: given_output_unit
	use format_defs, only: FMT_14, FMT_19
	use string_utils, only: str
	use process_libraries, only: process_component_def_t
	use process_libraries, only: process_library_t
	use process_libraries, only: STAT_ACTIVE
	use prclib_stacks, only: prclib_entry_t
	use compilations, only: compile_library
	use integrations, only: integrate_process

	implicit none

	contains

	<<Restricted subprocesses: procedures>>

	end submodule restricted_subprocesses_s

	@ %def restricted_subprocesses_s
	@
	\subsection{Process configuration}
	We extend the [[process_configuration_t]] by another method for initialization
	that takes into account a resonance history.
	<<Restricted subprocesses: public>>=
	public :: restricted_process_configuration_t
	<<Restricted subprocesses: types>>=
	type, extends (process_configuration_t) :: restricted_process_configuration_t
	private
	contains
	<<Restricted subprocesses: restricted process configuration: TBP>>
	end type restricted_process_configuration_t

	@ %def restricted_process_configuration_t
	@
	Resonance history as an argument. We use it to override the [[restrictions]]
	setting in a local variable list. Since we can construct the restricted
	process only by using OMega, we enforce it as the ME method. Other settings
	are taken from the variable list. The model will most likely be set, but we
	insert a safeguard just in case.

	Also, the resonant subprocess should not itself spawn resonant
	subprocesses, so we unset [[?resonance_history]].

	We have to create a local copy of the model here, via pointer
	allocation. The reason is that the model as stored (via pointer) in
	the base type will be finalized and deallocated.

	The current implementation will generate a LO process, the optional
	[[nlo_process]] is unset. (It is not obvious
	whether the construction makes sense beyond LO.)
	<<Restricted subprocesses: restricted process configuration: TBP>>=
	procedure :: init_resonant_process
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine init_resonant_process &
	(prc_config, prc_name, prt_in, prt_out, res_history, model, var_list)
	class(restricted_process_configuration_t), intent(out) :: prc_config
	type(string_t), intent(in) :: prc_name
	type(prt_spec_t), dimension(:), intent(in) :: prt_in
	type(prt_spec_t), dimension(:), intent(in) :: prt_out
	type(resonance_history_t), intent(in) :: res_history
	type(model_t), intent(in), target :: model
	type(var_list_t), intent(in), target :: var_list
	end subroutine init_resonant_process
	<<Restricted subprocesses: procedures>>=
	module subroutine init_resonant_process &
	(prc_config, prc_name, prt_in, prt_out, res_history, model, var_list)
	class(restricted_process_configuration_t), intent(out) :: prc_config
	type(string_t), intent(in) :: prc_name
	type(prt_spec_t), dimension(:), intent(in) :: prt_in
	type(prt_spec_t), dimension(:), intent(in) :: prt_out
	type(resonance_history_t), intent(in) :: res_history
	type(model_t), intent(in), target :: model
	type(var_list_t), intent(in), target :: var_list
	type(model_t), pointer :: local_model
	type(var_list_t) :: local_var_list
	allocate (local_model)
	call local_model%init_instance (model)
	call local_var_list%link (var_list)
	call local_var_list%append_string (var_str ("$model_name"), &
	sval = local_model%get_name (), &
	intrinsic=.true.)
	call local_var_list%append_string (var_str ("$method"), &
	sval = var_str ("omega"), &
	intrinsic=.true.)
	call local_var_list%append_string (var_str ("$restrictions"), &
	sval = res_history%as_omega_string (size (prt_in)), &
	intrinsic = .true.)
	call local_var_list%append_log (var_str ("?resonance_history"), &
	lval = .false., &
	intrinsic = .true.)
	call prc_config%init (prc_name, size (prt_in), 1, &
	local_model, local_var_list)
	call prc_config%setup_component (1, &
	prt_in, prt_out, &
	local_model, local_var_list)
	end subroutine init_resonant_process

	@ %def init_resonant_process
	@
	\subsection{Resonant-subprocess set manager}
	This data type enables generation of a library of resonant subprocesses for a
	given master process, and it allows for convenient access. The matrix
	elements from the subprocesses can be used as channel weights to activate a
	selector, which then returns a preferred channel via some random number
	generator.
	<<Restricted subprocesses: public>>=
	public :: resonant_subprocess_set_t
	<<Restricted subprocesses: types>>=
	type :: resonant_subprocess_set_t
	private
	integer, dimension(:), allocatable :: n_history
	type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
	logical :: lib_active = .false.
	type(string_t) :: libname
	type(string_t), dimension(:), allocatable :: proc_id
	type(process_ptr_t), dimension(:), allocatable :: subprocess
	type(process_instance_ptr_t), dimension(:), allocatable :: instance
	logical :: filled = .false.
	type(evt_resonance_t), pointer :: evt => null ()
	contains
	<<Restricted subprocesses: resonant subprocess set: TBP>>
	end type resonant_subprocess_set_t

	@ %def resonant_subprocess_set_t
	@ Output
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: write => resonant_subprocess_set_write
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_write (prc_set, unit, testflag)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine resonant_subprocess_set_write
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_write (prc_set, unit, testflag)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	logical :: truncate
	integer :: u, i
	u = given_output_unit (unit)
	truncate = .false.; if (present (testflag)) truncate = testflag
	write (u, "(1x,A)") "Resonant subprocess set:"
	if (allocated (prc_set%n_history)) then
	if (any (prc_set%n_history > 0)) then
	do i = 1, size (prc_set%n_history)
	if (prc_set%n_history(i) > 0) then
	write (u, "(1x,A,I0)") "Component #", i
	call prc_set%res_history_set(i)%write (u, indent=1)
	end if
	end do
	if (prc_set%lib_active) then
	write (u, "(3x,A,A,A)") "Process library = '", &
	char (prc_set%libname), "'"
	else
	write (u, "(3x,A)") "Process library: [inactive]"
	end if
	if (associated (prc_set%evt)) then
	if (truncate) then
	write (u, "(3x,A,1x," // FMT_14 // ")") &
	"Process sqme =", prc_set%get_master_sqme ()
	else
	write (u, "(3x,A,1x," // FMT_19 // ")") &
	"Process sqme =", prc_set%get_master_sqme ()
	end if
	end if
	if (associated (prc_set%evt)) then
	write (u, "(3x,A)") "Event transform: associated"
	write (u, "(2x)", advance="no")
	call prc_set%evt%write_selector (u, testflag)
	else
	write (u, "(3x,A)") "Event transform: not associated"
	end if
	else
	write (u, "(2x,A)") "[empty]"
	end if
	else
	write (u, "(3x,A)") "[not allocated]"
	end if
	end subroutine resonant_subprocess_set_write

	@ %def resonant_subprocess_set_write
	@
	\subsection{Resonance history set}
	Initialize subprocess set with an array of pre-created resonance
	history sets.

	Safeguard: if there are no resonances in the input, initialize the local set
	as empty, but complete.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: init => resonant_subprocess_set_init
	procedure :: fill_resonances => resonant_subprocess_set_fill_resonances
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_init (prc_set, n_component)
	class(resonant_subprocess_set_t), intent(out) :: prc_set
	integer, intent(in) :: n_component
	end subroutine resonant_subprocess_set_init
	module subroutine resonant_subprocess_set_fill_resonances (prc_set, &
	res_history_set, i_component)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(resonance_history_set_t), intent(in) :: res_history_set
	integer, intent(in) :: i_component
	end subroutine resonant_subprocess_set_fill_resonances
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_init (prc_set, n_component)
	class(resonant_subprocess_set_t), intent(out) :: prc_set
	integer, intent(in) :: n_component
	allocate (prc_set%res_history_set (n_component))
	allocate (prc_set%n_history (n_component), source = 0)
	end subroutine resonant_subprocess_set_init

	module subroutine resonant_subprocess_set_fill_resonances (prc_set, &
	res_history_set, i_component)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(resonance_history_set_t), intent(in) :: res_history_set
	integer, intent(in) :: i_component
	prc_set%n_history(i_component) = res_history_set%get_n_history ()
	if (prc_set%n_history(i_component) > 0) then
	prc_set%res_history_set(i_component) = res_history_set
	else
	call prc_set%res_history_set(i_component)%init (initial_size = 0)
	call prc_set%res_history_set(i_component)%freeze ()
	end if
	end subroutine resonant_subprocess_set_fill_resonances

	@ %def resonant_subprocess_set_init
	@ %def resonant_subprocess_set_fill_resonances
	@ Return the resonance history set.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: get_resonance_history_set &
	=> resonant_subprocess_set_get_resonance_history_set
	<<Restricted subprocesses: sub interfaces>>=
	module function resonant_subprocess_set_get_resonance_history_set &
	(prc_set) result (res_history_set)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	type(resonance_history_set_t), dimension(:), allocatable :: &
	res_history_set
	end function resonant_subprocess_set_get_resonance_history_set
	<<Restricted subprocesses: procedures>>=
	module function resonant_subprocess_set_get_resonance_history_set &
	(prc_set) result (res_history_set)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	type(resonance_history_set_t), dimension(:), allocatable :: &
	res_history_set
	res_history_set = prc_set%res_history_set
	end function resonant_subprocess_set_get_resonance_history_set

	@ %def resonant_subprocess_set_get_resonance_history_set
	@
	\subsection{Library for the resonance history set}
	The recommended library name: append [[_R]] to the process name.
	<<Restricted subprocesses: public>>=
	public :: get_libname_res
	<<Restricted subprocesses: sub interfaces>>=
	elemental module function get_libname_res (proc_id) result (libname)
	type(string_t), intent(in) :: proc_id
	type(string_t) :: libname
	end function get_libname_res
	<<Restricted subprocesses: procedures>>=
	elemental module function get_libname_res (proc_id) result (libname)
	type(string_t), intent(in) :: proc_id
	type(string_t) :: libname
	libname = proc_id // "_R"
	end function get_libname_res

	@ %def get_libname_res
	@ Here we scan the global process library whether any
	processes require resonant subprocesses to be constructed. If yes,
	create process objects with phase space and construct the process
	libraries as usual. Then append the library names to the array.

	The temporary integration objects should carry the [[phs_only]]
	flag. We set this in the local environment.

	Once a process object with resonance histories (derived from phase
	space) has been created, we extract the resonance histories and use
	them, together with the process definition, to create the new library.

	Finally, compile the library.
	<<Restricted subprocesses: public>>=
	public :: spawn_resonant_subprocess_libraries
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine spawn_resonant_subprocess_libraries &
	(libname, local, global, libname_res)
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), target :: global
	type(string_t), dimension(:), allocatable, intent(inout) :: libname_res
	end subroutine spawn_resonant_subprocess_libraries
	<<Restricted subprocesses: procedures>>=
	module subroutine spawn_resonant_subprocess_libraries &
	(libname, local, global, libname_res)
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), target :: global
	type(string_t), dimension(:), allocatable, intent(inout) :: libname_res
	type(process_library_t), pointer :: lib
	type(string_t), dimension(:), allocatable :: process_id_res
	type(process_t), pointer :: process
	type(resonance_history_set_t) :: res_history_set
	type(process_component_def_t), pointer :: process_component_def
	logical :: phs_only_saved, exist
	integer :: i_proc, i_component
	lib => global%prclib_stack%get_library_ptr (libname)
	call lib%get_process_id_req_resonant (process_id_res)
	if (size (process_id_res) > 0) then
	call msg_message ("Creating resonant-subprocess libraries &
	&for library '" // char (libname) // "'")
	libname_res = get_libname_res (process_id_res)
	phs_only_saved = local%var_list%get_lval (var_str ("?phs_only"))
	call local%var_list%set_log &
	(var_str ("?phs_only"), .true., is_known=.true.)
	do i_proc = 1, size (process_id_res)
	associate (proc_id => process_id_res (i_proc))
	call msg_message ("Process '" // char (proc_id) // "': &
	&constructing phase space for resonance structure")
	call integrate_process (proc_id, local, global)
	process => global%process_stack%get_process_ptr (proc_id)
	call create_library (libname_res(i_proc), global, exist)
	if (.not. exist) then
	do i_component = 1, process%get_n_components ()
	call process%extract_resonance_history_set &
	(res_history_set, i_component = i_component)
	process_component_def &
	=> process%get_component_def_ptr (i_component)
	call add_to_library (libname_res(i_proc), &
	res_history_set, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end do
	call msg_message ("Process library '" &
	// char (libname_res(i_proc)) &
	// "': created")
	end if
	call global%update_prclib (lib)
	end associate
	end do
	call local%var_list%set_log &
	(var_str ("?phs_only"), phs_only_saved, is_known=.true.)
	end if
	end subroutine spawn_resonant_subprocess_libraries

	@ %def spawn_resonant_subprocess_libraries
	@ This is another version of the library constructor, bound to a
	restricted-subprocess set object. Create the appropriate
	process library, add processes, and close the library.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: create_library => resonant_subprocess_set_create_library
	procedure :: add_to_library => resonant_subprocess_set_add_to_library
	procedure :: freeze_library => resonant_subprocess_set_freeze_library
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_create_library (prc_set, &
	libname, global, exist)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: global
	logical, intent(out) :: exist
	end subroutine resonant_subprocess_set_create_library
	module subroutine resonant_subprocess_set_add_to_library (prc_set, &
	i_component, prt_in, prt_out, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	integer, intent(in) :: i_component
	type(prt_spec_t), dimension(:), intent(in) :: prt_in
	type(prt_spec_t), dimension(:), intent(in) :: prt_out
	type(rt_data_t), intent(inout), target :: global
	end subroutine resonant_subprocess_set_add_to_library
	module subroutine resonant_subprocess_set_freeze_library (prc_set, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(rt_data_t), intent(inout), target :: global
	end subroutine resonant_subprocess_set_freeze_library
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_create_library (prc_set, &
	libname, global, exist)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: global
	logical, intent(out) :: exist
	prc_set%libname = libname
	call create_library (prc_set%libname, global, exist)
	end subroutine resonant_subprocess_set_create_library

	module subroutine resonant_subprocess_set_add_to_library (prc_set, &
	i_component, prt_in, prt_out, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	integer, intent(in) :: i_component
	type(prt_spec_t), dimension(:), intent(in) :: prt_in
	type(prt_spec_t), dimension(:), intent(in) :: prt_out
	type(rt_data_t), intent(inout), target :: global
	call add_to_library (prc_set%libname, &
	prc_set%res_history_set(i_component), &
	prt_in, prt_out, global)
	end subroutine resonant_subprocess_set_add_to_library

	module subroutine resonant_subprocess_set_freeze_library (prc_set, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(rt_data_t), intent(inout), target :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	lib => global%prclib_stack%get_library_ptr (prc_set%libname)
	call lib%get_process_id_list (prc_set%proc_id)
	prc_set%lib_active = .true.
	end subroutine resonant_subprocess_set_freeze_library

	@ %def resonant_subprocess_set_create_library
	@ %def resonant_subprocess_set_add_to_library
	@ %def resonant_subprocess_set_freeze_library
	@ The common parts of the procedures above: (i) create a new process
	library or recover it, (ii) for each history, create a
	process configuration and record it.
	<<Restricted subprocesses: procedures>>=
	subroutine create_library (libname, global, exist)
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: global
	logical, intent(out) :: exist
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	type(resonance_history_t) :: res_history
	type(string_t), dimension(:), allocatable :: proc_id
	type(restricted_process_configuration_t) :: prc_config
	integer :: i
	lib => global%prclib_stack%get_library_ptr (libname)
	exist = associated (lib)
	if (.not. exist) then
	call msg_message ("Creating library for resonant subprocesses '" &
	// char (libname) // "'")
	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)
	else
	call msg_message ("Using library for resonant subprocesses '" &
	// char (libname) // "'")
	call global%update_prclib (lib)
	end if
	end subroutine create_library

	subroutine add_to_library (libname, res_history_set, prt_in, prt_out, global)
	type(string_t), intent(in) :: libname
	type(resonance_history_set_t), intent(in) :: res_history_set
	type(prt_spec_t), dimension(:), intent(in) :: prt_in
	type(prt_spec_t), dimension(:), intent(in) :: prt_out
	type(rt_data_t), intent(inout), target :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	type(resonance_history_t) :: res_history
	type(string_t), dimension(:), allocatable :: proc_id
	type(restricted_process_configuration_t) :: prc_config
	integer :: n0, i
	lib => global%prclib_stack%get_library_ptr (libname)
	if (associated (lib)) then
	n0 = lib%get_n_processes ()
	allocate (proc_id (res_history_set%get_n_history ()))
	do i = 1, size (proc_id)
	proc_id(i) = libname // str (n0 + i)
	res_history = res_history_set%get_history(i)
	call prc_config%init_resonant_process (proc_id(i), &
	prt_in, prt_out, &
	res_history, &
	global%model, global%var_list)
	call msg_message ("Resonant subprocess #" &
	// char (str(n0+i)) // ": " &
	// char (res_history%as_omega_string (size (prt_in))))
	call prc_config%record (global)
	if (signal_is_pending ()) return
	end do
	else
	call msg_bug ("Adding subprocesses: library '" &
	// char (libname) // "' not found")
	end if
	end subroutine add_to_library

	@ %def create_library
	@ %def add_to_library
	@ Compile the generated library, required settings taken from the
	[[global]] data set.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: compile_library => resonant_subprocess_set_compile_library
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_compile_library (prc_set, global)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	type(rt_data_t), intent(inout), target :: global
	end subroutine resonant_subprocess_set_compile_library
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_compile_library (prc_set, global)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	type(rt_data_t), intent(inout), target :: global
	type(process_library_t), pointer :: lib
	lib => global%prclib_stack%get_library_ptr (prc_set%libname)
	if (lib%get_status () < STAT_ACTIVE) then
	call compile_library (prc_set%libname, global)
	end if
	end subroutine resonant_subprocess_set_compile_library

	@ %def resonant_subprocess_set_compile_library
	@ Check if the library has been created / the process has been evaluated.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: is_active => resonant_subprocess_set_is_active
	<<Restricted subprocesses: sub interfaces>>=
	module function resonant_subprocess_set_is_active (prc_set) result (flag)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	logical :: flag
	end function resonant_subprocess_set_is_active
	<<Restricted subprocesses: procedures>>=
	module function resonant_subprocess_set_is_active (prc_set) result (flag)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	logical :: flag
	flag = prc_set%lib_active
	end function resonant_subprocess_set_is_active

	@ %def resonant_subprocess_set_is_active
	@ Return number of generated process objects, library, and process IDs.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: get_n_process => resonant_subprocess_set_get_n_process
	procedure :: get_libname => resonant_subprocess_set_get_libname
	procedure :: get_proc_id => resonant_subprocess_set_get_proc_id
	<<Restricted subprocesses: sub interfaces>>=
	module function resonant_subprocess_set_get_n_process (prc_set) result (n)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer :: n
	end function resonant_subprocess_set_get_n_process
	module function resonant_subprocess_set_get_libname &
	(prc_set) result (libname)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	type(string_t) :: libname
	end function resonant_subprocess_set_get_libname
	module function resonant_subprocess_set_get_proc_id &
	(prc_set, i) result (proc_id)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer, intent(in) :: i
	type(string_t) :: proc_id
	end function resonant_subprocess_set_get_proc_id
	<<Restricted subprocesses: procedures>>=
	module function resonant_subprocess_set_get_n_process (prc_set) result (n)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer :: n
	if (prc_set%lib_active) then
	n = size (prc_set%proc_id)
	else
	n = 0
	end if
	end function resonant_subprocess_set_get_n_process

	module function resonant_subprocess_set_get_libname (prc_set) result (libname)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	type(string_t) :: libname
	if (prc_set%lib_active) then
	libname = prc_set%libname
	else
	libname = ""
	end if
	end function resonant_subprocess_set_get_libname

	module function resonant_subprocess_set_get_proc_id &
	(prc_set, i) result (proc_id)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer, intent(in) :: i
	type(string_t) :: proc_id
	if (allocated (prc_set%proc_id)) then
	proc_id = prc_set%proc_id(i)
	else
	proc_id = ""
	end if
	end function resonant_subprocess_set_get_proc_id

	@ %def resonant_subprocess_set_get_n_process
	@ %def resonant_subprocess_set_get_libname
	@ %def resonant_subprocess_set_get_proc_id
	@
	\subsection{Process objects and instances}
	Prepare process objects for all entries in the resonant-subprocesses
	library. The process objects are appended to the global process
	stack. A local environment can be used where we place temporary
	variable settings that affect process-object generation. We
	initialize the processes, such that we can evaluate matrix elements,
	but we do not need to integrate them.

	The internal procedure [[prepare_process]] is an abridged version of
	the procedure with this name in the [[simulations]] module.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: prepare_process_objects &
	=> resonant_subprocess_set_prepare_process_objects
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_prepare_process_objects &
	(prc_set, local, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	end subroutine resonant_subprocess_set_prepare_process_objects
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_prepare_process_objects &
	(prc_set, local, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	type(rt_data_t), pointer :: current
	type(process_library_t), pointer :: lib
	type(string_t) :: phs_method_saved, integration_method_saved
	type(string_t) :: proc_id, libname_cur, libname_res
	integer :: i, n
	if (.not. prc_set%is_active ()) return
	if (present (global)) then
	current => global
	else
	current => local
	end if
	libname_cur = current%prclib%get_name ()
	libname_res = prc_set%get_libname ()
	lib => current%prclib_stack%get_library_ptr (libname_res)
	if (associated (lib)) call current%update_prclib (lib)
	phs_method_saved = local%get_sval (var_str ("$phs_method"))
	integration_method_saved = local%get_sval (var_str ("$integration_method"))
	call local%set_string (var_str ("$phs_method"), &
	var_str ("none"), is_known = .true.)
	call local%set_string (var_str ("$integration_method"), &
	var_str ("none"), is_known = .true.)
	n = prc_set%get_n_process ()
	allocate (prc_set%subprocess (n))
	do i = 1, n
	proc_id = prc_set%get_proc_id (i)
	call prepare_process (prc_set%subprocess(i)%p, proc_id)
	if (signal_is_pending ()) return
	end do
	call local%set_string (var_str ("$phs_method"), &
	phs_method_saved, is_known = .true.)
	call local%set_string (var_str ("$integration_method"), &
	integration_method_saved, is_known = .true.)
	lib => current%prclib_stack%get_library_ptr (libname_cur)
	if (associated (lib)) call current%update_prclib (lib)
	contains
	subroutine prepare_process (process, process_id)
	type(process_t), pointer, intent(out) :: process
	type(string_t), intent(in) :: process_id
	call msg_message ("Simulate: initializing resonant subprocess '" &
	// char (process_id) // "'")
	if (present (global)) then
	call integrate_process (process_id, local, global, &
	init_only = .true.)
	else
	call integrate_process (process_id, local, local_stack = .true., &
	init_only = .true.)
	end if
	process => current%process_stack%get_process_ptr (process_id)
	if (.not. associated (process)) then
	call msg_fatal ("Simulate: resonant subprocess '" &
	// char (process_id) // "' could not be initialized: aborting")
	end if
	end subroutine prepare_process
	end subroutine resonant_subprocess_set_prepare_process_objects

	@ %def resonant_subprocess_set_prepare_process_objects
	@ Workspace for the resonant subprocesses.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: prepare_process_instances &
	=> resonant_subprocess_set_prepare_process_instances
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_prepare_process_instances &
	(prc_set, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(rt_data_t), intent(in), target :: global
	end subroutine resonant_subprocess_set_prepare_process_instances
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_prepare_process_instances &
	(prc_set, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(rt_data_t), intent(in), target :: global
	integer :: i, n
	if (.not. prc_set%is_active ()) return
	n = size (prc_set%subprocess)
	allocate (prc_set%instance (n))
	do i = 1, n
	allocate (prc_set%instance(i)%p)
	call prc_set%instance(i)%p%init (prc_set%subprocess(i)%p)
	call prc_set%instance(i)%p%setup_event_data (global%model)
	end do
	end subroutine resonant_subprocess_set_prepare_process_instances

	@ %def resonant_subprocess_set_prepare_process_instances
	@
	\subsection{Event transform connection}
	The idea is that the resonance-insertion event transform has been
	allocated somewhere (namely, in the standard event-transform chain),
	but we maintain a link such that we can inject matrix-element results
	event by event. The event transform holds a selector, to choose one
	of the resonance histories (or none), and it manages resonance
	insertion for the particle set.

	The data that the event transform requires can be provided here. The
	resonance history set has already been assigned with the [[dispatch]]
	initializer. Here, we supply the set of subprocess instances that we
	have generated (see above). The master-process instance is set
	when we [[connect]] the transform by the standard method.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: connect_transform => &
	resonant_subprocess_set_connect_transform
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_connect_transform (prc_set, evt)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	class(evt_t), intent(in), target :: evt
	end subroutine resonant_subprocess_set_connect_transform
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_connect_transform (prc_set, evt)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	class(evt_t), intent(in), target :: evt
	select type (evt)
	type is (evt_resonance_t)
	prc_set%evt => evt
	call prc_set%evt%set_subprocess_instances (prc_set%instance)
	class default
	call msg_bug ("Resonant subprocess set: event transform has wrong type")
	end select
	end subroutine resonant_subprocess_set_connect_transform

	@ %def resonant_subprocess_set_connect_transform
	@ Set the on-shell limit value in the connected transform.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: set_on_shell_limit => resonant_subprocess_set_on_shell_limit
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_on_shell_limit &
	(prc_set, on_shell_limit)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), intent(in) :: on_shell_limit
	end subroutine resonant_subprocess_set_on_shell_limit
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_on_shell_limit &
	(prc_set, on_shell_limit)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), intent(in) :: on_shell_limit
	call prc_set%evt%set_on_shell_limit (on_shell_limit)
	end subroutine resonant_subprocess_set_on_shell_limit

	@ %def resonant_subprocess_set_on_shell_limit
	@ Set the Gaussian turnoff parameter in the connected transform.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: set_on_shell_turnoff => resonant_subprocess_set_on_shell_turnoff
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_on_shell_turnoff &
	(prc_set, on_shell_turnoff)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), intent(in) :: on_shell_turnoff
	end subroutine resonant_subprocess_set_on_shell_turnoff
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_on_shell_turnoff &
	(prc_set, on_shell_turnoff)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), intent(in) :: on_shell_turnoff
	call prc_set%evt%set_on_shell_turnoff (on_shell_turnoff)
	end subroutine resonant_subprocess_set_on_shell_turnoff

	@ %def resonant_subprocess_set_on_shell_turnoff
	@ Reweight (suppress) the background contribution probability, for the
	kinematics where a resonance history is active.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: set_background_factor &
	=> resonant_subprocess_set_background_factor
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_background_factor &
	(prc_set, background_factor)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), intent(in) :: background_factor
	end subroutine resonant_subprocess_set_background_factor
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_background_factor &
	(prc_set, background_factor)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), intent(in) :: background_factor
	call prc_set%evt%set_background_factor (background_factor)
	end subroutine resonant_subprocess_set_background_factor

	@ %def resonant_subprocess_set_background_factor
	@
	\subsection{Wrappers for runtime calculations}
	All runtime calculations are delegated to the event transform. The
	following procedures are essentially redundant wrappers. We retain
	them for a unit test below.

	Debugging aid:
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: dump_instances => resonant_subprocess_set_dump_instances
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_dump_instances &
	(prc_set, unit, testflag)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine resonant_subprocess_set_dump_instances
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_dump_instances &
	(prc_set, unit, testflag)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: i, n, u
	u = given_output_unit (unit)
	write (u, "(A)") "*** Process instances of resonant subprocesses"
	write (u, *)
	n = size (prc_set%subprocess)
	do i = 1, n
	associate (instance => prc_set%instance(i)%p)
	call instance%write (u, testflag)
	write (u, *)
	write (u, *)
	end associate
	end do
	end subroutine resonant_subprocess_set_dump_instances

	@ %def resonant_subprocess_set_dump_instances
	@ Inject the current kinematics configuration, reading from the
	previous event transform or from the process instance.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: fill_momenta => resonant_subprocess_set_fill_momenta
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_fill_momenta (prc_set)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	end subroutine resonant_subprocess_set_fill_momenta
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_fill_momenta (prc_set)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	integer :: i, n
	call prc_set%evt%fill_momenta ()
	end subroutine resonant_subprocess_set_fill_momenta

	@ %def resonant_subprocess_set_fill_momenta
	@ Determine the indices of the resonance histories that can be
	considered on-shell for the current kinematics.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: determine_on_shell_histories &
	=> resonant_subprocess_set_determine_on_shell_histories
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_determine_on_shell_histories &
	(prc_set, i_component, index_array)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer, intent(in) :: i_component
	integer, dimension(:), allocatable, intent(out) :: index_array
	end subroutine resonant_subprocess_set_determine_on_shell_histories
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_determine_on_shell_histories &
	(prc_set, i_component, index_array)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer, intent(in) :: i_component
	integer, dimension(:), allocatable, intent(out) :: index_array
	call prc_set%evt%determine_on_shell_histories (index_array)
	end subroutine resonant_subprocess_set_determine_on_shell_histories

	@ %def resonant_subprocess_set_determine_on_shell_histories
	@ Evaluate selected subprocesses. (In actual operation, the ones that
	have been tagged as on-shell.)
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: evaluate_subprocess &
	=> resonant_subprocess_set_evaluate_subprocess
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_evaluate_subprocess &
	(prc_set, index_array)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	integer, dimension(:), intent(in) :: index_array
	end subroutine resonant_subprocess_set_evaluate_subprocess
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_evaluate_subprocess &
	(prc_set, index_array)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	integer, dimension(:), intent(in) :: index_array
	call prc_set%evt%evaluate_subprocess (index_array)
	end subroutine resonant_subprocess_set_evaluate_subprocess

	@ %def resonant_subprocess_set_evaluate_subprocess
	@ Extract the matrix elements of the master process / the resonant
	subprocesses. After the previous routine has been executed, they
	should be available and stored in the corresponding process instances.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: get_master_sqme &
	=> resonant_subprocess_set_get_master_sqme
	procedure :: get_subprocess_sqme &
	=> resonant_subprocess_set_get_subprocess_sqme
	<<Restricted subprocesses: sub interfaces>>=
	module function resonant_subprocess_set_get_master_sqme &
	(prc_set) result (sqme)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	real(default) :: sqme
	end function resonant_subprocess_set_get_master_sqme
	module subroutine resonant_subprocess_set_get_subprocess_sqme &
	(prc_set, sqme)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	real(default), dimension(:), intent(inout) :: sqme
	end subroutine resonant_subprocess_set_get_subprocess_sqme
	<<Restricted subprocesses: procedures>>=
	module function resonant_subprocess_set_get_master_sqme &
	(prc_set) result (sqme)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	real(default) :: sqme
	sqme = prc_set%evt%get_master_sqme ()
	end function resonant_subprocess_set_get_master_sqme

	module subroutine resonant_subprocess_set_get_subprocess_sqme (prc_set, sqme)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	real(default), dimension(:), intent(inout) :: sqme
	integer :: i
	call prc_set%evt%get_subprocess_sqme (sqme)
	end subroutine resonant_subprocess_set_get_subprocess_sqme

	@ %def resonant_subprocess_set_get_master_sqme
	@ %def resonant_subprocess_set_get_subprocess_sqme
	@ We use the calculations of resonant matrix elements to determine
	probabilities for all resonance configurations.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: compute_probabilities &
	=> resonant_subprocess_set_compute_probabilities
	<<Restricted subprocesses: sub interfaces>>=
	module subroutine resonant_subprocess_set_compute_probabilities &
	(prc_set, prob_array)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), dimension(:), allocatable, intent(out) :: prob_array
	end subroutine resonant_subprocess_set_compute_probabilities
	<<Restricted subprocesses: procedures>>=
	module subroutine resonant_subprocess_set_compute_probabilities &
	(prc_set, prob_array)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), dimension(:), allocatable, intent(out) :: prob_array
	integer, dimension(:), allocatable :: index_array
	real(default) :: sqme, sqme_sum, sqme_bg
	real(default), dimension(:), allocatable :: sqme_res
	integer :: n
	n = size (prc_set%subprocess)
	allocate (prob_array (0:n), source = 0._default)
	call prc_set%evt%compute_probabilities ()
	call prc_set%evt%get_selector_weights (prob_array)
	end subroutine resonant_subprocess_set_compute_probabilities

	@ %def resonant_subprocess_set_compute_probabilities
	@
	\subsection{Unit tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[restricted_subprocesses_ut.f90]]>>=
	<<File header>>

	module restricted_subprocesses_ut
	use unit_tests
	use restricted_subprocesses_uti

	<<Standard module head>>

	<<Restricted subprocesses: public test>>

	contains

	<<Restricted subprocesses: test driver>>

	end module restricted_subprocesses_ut
	@ %def restricted_subprocesses_ut
	@
	<<[[restricted_subprocesses_uti.f90]]>>=
	<<File header>>

	module restricted_subprocesses_uti

	<<Use kinds>>
	<<Use strings>>
	use io_units, only: free_unit
	use format_defs, only: FMT_10, FMT_12
	use lorentz, only: vector4_t, vector3_moving, vector4_moving
	use particle_specifiers, only: new_prt_spec
	use process_libraries, only: process_library_t
	use resonances, only: resonance_info_t
	use resonances, only: resonance_history_t
	use resonances, only: resonance_history_set_t
	use state_matrices, only: FM_IGNORE_HELICITY
	use particles, only: particle_set_t
	use model_data, only: model_data_t
	use models, only: syntax_model_file_init, syntax_model_file_final
	use models, only: model_t
	use rng_base_ut, only: rng_test_factory_t
	use mci_base, only: mci_t
	use phs_base, only: phs_config_t
	use phs_forests, only: syntax_phs_forest_init, syntax_phs_forest_final
	use phs_wood, only: phs_wood_config_t
	use process_libraries, only: process_def_entry_t
	use process_libraries, only: process_component_def_t
	use prclib_stacks, only: prclib_entry_t
	use prc_core_def, only: prc_core_def_t
	use prc_omega, only: omega_def_t
	use process, only: process_t
	use instances, only: process_instance_t
	use process_stacks, only: process_entry_t
	use event_transforms, only: evt_trivial_t
	use resonance_insertion, only: evt_resonance_t
	use integrations, only: integrate_process
	use rt_data, only: rt_data_t

	use restricted_subprocesses

	<<Standard module head>>

	<<Restricted subprocesses: test declarations>>

	<<Restricted subprocesses: test auxiliary types>>

	<<Restricted subprocesses: public test auxiliary>>

	contains

	<<Restricted subprocesses: tests>>

	<<Restricted subprocesses: test auxiliary>>

	end module restricted_subprocesses_uti

	@ %def restricted_subprocesses_uti
	@ API: driver for the unit tests below.
	<<Restricted subprocesses: public test>>=
	public :: restricted_subprocesses_test
	<<Restricted subprocesses: test driver>>=
	subroutine restricted_subprocesses_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Restricted subprocesses: execute tests>>
	end subroutine restricted_subprocesses_test

	@ %def restricted_subprocesses_test
	@
	\subsubsection{subprocess configuration}
	Initialize a [[restricted_subprocess_configuration_t]] object which represents
	a given process with a defined resonance history.
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_1, "restricted_subprocesses_1", &
	"single subprocess", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_1
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_1 (u)
	integer, intent(in) :: u
	type(rt_data_t) :: global
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(string_t) :: prc_name
	type(string_t), dimension(2) :: prt_in
	type(string_t), dimension(3) :: prt_out
	type(restricted_process_configuration_t) :: prc_config

	write (u, "(A)") "* Test output: restricted_subprocesses_1"
	write (u, "(A)") "* Purpose: create subprocess list from resonances"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%select_model (var_str ("SM"))

	write (u, "(A)") "* Create resonance history"
	write (u, "(A)")

	call res_info%init (3, -24, global%model, 5)
	call res_history%add_resonance (res_info)
	call res_history%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Create process configuration"
	write (u, "(A)")

	prc_name = "restricted_subprocesses_1_p"
	prt_in(1) = "e-"
	prt_in(2) = "e+"
	prt_out(1) = "d"
	prt_out(2) = "u"
	prt_out(3) = "W+"

	call prc_config%init_resonant_process (prc_name, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), &
	res_history, global%model, global%var_list)

	call prc_config%write (u)

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_1"

	end subroutine restricted_subprocesses_1

	@ %def restricted_subprocesses_1
	@
	\subsubsection{Subprocess library configuration}
	Create a process library that represents restricted subprocesses for a given
	set of resonance histories
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_2, "restricted_subprocesses_2", &
	"subprocess library", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_2
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_2 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(resonance_info_t) :: res_info
	type(resonance_history_t), dimension(2) :: res_history
	type(resonance_history_set_t) :: res_history_set
	type(string_t) :: libname
	type(string_t), dimension(2) :: prt_in
	type(string_t), dimension(3) :: prt_out
	type(resonant_subprocess_set_t) :: prc_set
	type(process_library_t), pointer :: lib
	logical :: exist

	write (u, "(A)") "* Test output: restricted_subprocesses_2"
	write (u, "(A)") "* Purpose: create subprocess library from resonances"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%select_model (var_str ("SM"))

	write (u, "(A)") "* Create resonance histories"
	write (u, "(A)")

	call res_info%init (3, -24, global%model, 5)
	call res_history(1)%add_resonance (res_info)
	call res_history(1)%write (u)

	call res_info%init (7, 23, global%model, 5)
	call res_history(2)%add_resonance (res_info)
	call res_history(2)%write (u)

	call res_history_set%init ()
	call res_history_set%enter (res_history(1))
	call res_history_set%enter (res_history(2))
	call res_history_set%freeze ()

	write (u, "(A)")
	write (u, "(A)") "* Empty restricted subprocess set"
	write (u, "(A)")

	write (u, "(A,1x,L1)") "active =", prc_set%is_active ()
	write (u, "(A)")

	call prc_set%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill restricted subprocess set"
	write (u, "(A)")

	libname = "restricted_subprocesses_2_p_R"
	prt_in(1) = "e-"
	prt_in(2) = "e+"
	prt_out(1) = "d"
	prt_out(2) = "u"
	prt_out(3) = "W+"

	call prc_set%init (1)
	call prc_set%fill_resonances (res_history_set, 1)
	call prc_set%create_library (libname, global, exist)
	if (.not. exist) then
	call prc_set%add_to_library (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), &
	global)
	end if
	call prc_set%freeze_library (global)

	write (u, "(A,1x,L1)") "active =", prc_set%is_active ()
	write (u, "(A)")

	call prc_set%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Queries"
	write (u, "(A)")

	write (u, "(A,1x,I0)") "n_process =", prc_set%get_n_process ()
	write (u, "(A)")
	write (u, "(A,A,A)") "libname = '", char (prc_set%get_libname ()), "'"
	write (u, "(A)")
	write (u, "(A,A,A)") "proc_id(1) = '", char (prc_set%get_proc_id (1)), "'"
	write (u, "(A,A,A)") "proc_id(2) = '", char (prc_set%get_proc_id (2)), "'"


	write (u, "(A)")
	write (u, "(A)") "* Process library"
	write (u, "(A)")

	call prc_set%compile_library (global)

	lib => global%prclib_stack%get_library_ptr (libname)
	if (associated (lib)) call lib%write (u, libpath=.false.)

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_2"

	end subroutine restricted_subprocesses_2

	@ %def restricted_subprocesses_2
	@
	\subsubsection{Auxiliary: Test processes}
	Auxiliary subroutine that constructs the process library for the above test.
	This parallels a similar subroutine in [[processes_uti]], but this time we
	want an \oMega\ process.
	<<Restricted subprocesses: public test auxiliary>>=
	public :: prepare_resonance_test_library
	<<Restricted subprocesses: test auxiliary>>=
	subroutine prepare_resonance_test_library &
	(lib, libname, procname, model, global, u)
	type(process_library_t), target, intent(out) :: lib
	type(string_t), intent(in) :: libname
	type(string_t), intent(in) :: procname
	class(model_data_t), intent(in), pointer :: model
	type(rt_data_t), intent(in), target :: global
	integer, intent(in) :: u
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry

	call lib%init (libname)

	allocate (prt_in (2), prt_out (3))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("d"), var_str ("ubar"), var_str ("W+")]

	allocate (omega_def_t :: def)
	select type (def)
	type is (omega_def_t)
	call def%init (model%get_name (), prt_in, prt_out, &
	ovm=.false., ufo=.false.)
	end select
	allocate (entry)
	call entry%init (procname, &
	model_name = model%get_name (), &
	n_in = 2, n_components = 1, &
	requires_resonances = .true.)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("omega"), &
	variant = def)
	call entry%write (u)

	call lib%append (entry)

	call lib%configure (global%os_data)
	call lib%write_makefile (global%os_data, force = .true., verbose = .false.)
	call lib%clean (global%os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (global%os_data)

	end subroutine prepare_resonance_test_library

	@ %def prepare_resonance_test_library
	@
	\subsubsection{Kinematics and resonance selection}
	Prepare an actual process with resonant subprocesses. Insert
	kinematics and apply the resonance selector in an associated event
	transform.
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_3, "restricted_subprocesses_3", &
	"resonance kinematics and probability", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_3
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_3 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(string_t) :: libname, libname_res
	type(string_t) :: procname
	type(process_component_def_t), pointer :: process_component_def
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	logical :: exist
	type(process_t), pointer :: process
	type(process_instance_t), target :: process_instance
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(resonant_subprocess_set_t) :: prc_set
	type(particle_set_t) :: pset
	real(default) :: sqrts, mw, pp
	real(default), dimension(3) :: p3
	type(vector4_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: m
	integer, dimension(:), allocatable :: pdg
	real(default), dimension(:), allocatable :: sqme
	logical, dimension(:), allocatable :: mask
	real(default) :: on_shell_limit
	integer, dimension(:), allocatable :: i_array
	real(default), dimension(:), allocatable :: prob_array
	type(evt_resonance_t), target :: evt_resonance
	integer :: i, u_dump

	write (u, "(A)") "* Test output: restricted_subprocesses_3"
	write (u, "(A)") "* Purpose: handle process and resonance kinematics"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)

	call global%select_model (var_str ("SM"))
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	libname = "restricted_subprocesses_3_lib"
	libname_res = "restricted_subprocesses_3_lib_res"
	procname = "restricted_subprocesses_3_p"

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	call integrate_process (procname, global, &
	local_stack = .true., init_only = .true.)

	process => global%process_stack%get_process_ptr (procname)

	call process_instance%init (process)
	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Extract resonance history set"
	write (u, "(A)")

	call process%extract_resonance_history_set &
	(res_history_set(1), include_trivial=.true., i_component=1)
	call res_history_set(1)%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Build resonant-subprocess library"
	write (u, "(A)")

	call prc_set%init (1)
	call prc_set%fill_resonances (res_history_set(1), 1)

	process_component_def => process%get_component_def_ptr (1)
	call prc_set%create_library (libname_res, global, exist)
	if (.not. exist) then
	call prc_set%add_to_library (1, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end if
	call prc_set%freeze_library (global)
	call prc_set%compile_library (global)
	call prc_set%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Build particle set"
	write (u, "(A)")

	sqrts = global%get_rval (var_str ("sqrts"))
	mw = 80._default ! deliberately slightly different from true mw
	pp = sqrt (sqrts*2 - 4 mw**2) / 2

	allocate (pdg (5), p (5), m (5))
	pdg(1) = -11
	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	m(1) = 0
	pdg(2) = 11
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	m(2) = 0
	pdg(3) = 1
	p3(1) = pp/2
	p3(2) = mw/2
	p3(3) = 0
	p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(3) = 0
	p3(2) = -mw/2
	pdg(4) = -2
	p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(4) = 0
	pdg(5) = 24
	p(5) = vector4_moving (sqrts/2,-pp, 1)
	m(5) = mw

	call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
	call pset%set_momentum (p, m**2)
	call pset%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill process instance"

	! workflow from event_recalculate
	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1)
	call process_instance%recover &
	(1, 1, update_sqme=.true., recover_phs=.false.)
	call process_instance%evaluate_event_data (weight = 1._default)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonant subprocesses"

	call prc_set%prepare_process_objects (global)
	call prc_set%prepare_process_instances (global)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call prc_set%connect_transform (evt_resonance)
	call evt_resonance%connect (process_instance, model)

	call prc_set%fill_momenta ()

	write (u, "(A)")
	write (u, "(A)") "* Show squared matrix element of master process,"
	write (u, "(A)") " should coincide with 2nd subprocess sqme"
	write (u, "(A)")

	write (u, "(1x,I0,1x," // FMT_12 // ")") 0, prc_set%get_master_sqme ()

	write (u, "(A)")
	write (u, "(A)") "* Compute squared matrix elements &
	&of selected resonant subprocesses [1,2]"
	write (u, "(A)")

	call prc_set%evaluate_subprocess ([1,2])

	allocate (sqme (3), source = 0._default)
	call prc_set%get_subprocess_sqme (sqme)
	do i = 1, size (sqme)
	write (u, "(1x,I0,1x," // FMT_12 // ")") i, sqme(i)
	end do
	deallocate (sqme)

	write (u, "(A)")
	write (u, "(A)") "* Compute squared matrix elements &
	&of all resonant subprocesses"
	write (u, "(A)")

	call prc_set%evaluate_subprocess ([1,2,3])

	allocate (sqme (3), source = 0._default)
	call prc_set%get_subprocess_sqme (sqme)
	do i = 1, size (sqme)
	write (u, "(1x,I0,1x," // FMT_12 // ")") i, sqme(i)
	end do
	deallocate (sqme)

	write (u, "(A)")
	write (u, "(A)") "* Write process instances to file &
	&restricted_subprocesses_3_lib_res.dat"

	u_dump = free_unit ()
	open (unit = u_dump, file = "restricted_subprocesses_3_lib_res.dat", &
	action = "write", status = "replace")
	call prc_set%dump_instances (u_dump)
	close (u_dump)

	write (u, "(A)")
	write (u, "(A)") "* Determine on-shell resonant subprocesses"
	write (u, "(A)")

	on_shell_limit = 0
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	write (u, "(1x,A,9(1x,I0))") "resonant =", i_array

	on_shell_limit = 0.1_default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	write (u, "(1x,A,9(1x,I0))") "resonant =", i_array

	on_shell_limit = 10._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	write (u, "(1x,A,9(1x,I0))") "resonant =", i_array

	on_shell_limit = 10000._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	write (u, "(1x,A,9(1x,I0))") "resonant =", i_array

	write (u, "(A)")
	write (u, "(A)") "* Compute probabilities for applicable resonances"
	write (u, "(A)") " and initialize the process selector"
	write (u, "(A)") " (The first number is the probability for background)"
	write (u, "(A)")

	on_shell_limit = 0
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	call prc_set%compute_probabilities (prob_array)
	write (u, "(1x,A,9(1x,"// FMT_12 // "))") "resonant =", prob_array
	call prc_set%write (u, testflag=.true.)
	write (u, *)

	on_shell_limit = 10._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	call prc_set%compute_probabilities (prob_array)
	write (u, "(1x,A,9(1x,"// FMT_12 // "))") "resonant =", prob_array
	call prc_set%write (u, testflag=.true.)
	write (u, *)

	on_shell_limit = 10000._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	call prc_set%compute_probabilities (prob_array)
	write (u, "(1x,A,9(1x,"// FMT_12 // "))") "resonant =", prob_array
	write (u, *)
	call prc_set%write (u, testflag=.true.)
	write (u, *)

	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_3"

	end subroutine restricted_subprocesses_3

	@ %def restricted_subprocesses_3
	@
	\subsubsection{Event transform}
	Prepare an actual process with resonant subprocesses. Prepare the
	resonance selector for a fixed event and apply the resonance-insertion
	event transform.
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_4, "restricted_subprocesses_4", &
	"event transform", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_4
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_4 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(string_t) :: libname, libname_res
	type(string_t) :: procname
	type(process_component_def_t), pointer :: process_component_def
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	logical :: exist
	type(process_t), pointer :: process
	type(process_instance_t), target :: process_instance
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(resonant_subprocess_set_t) :: prc_set
	type(particle_set_t) :: pset
	real(default) :: sqrts, mw, pp
	real(default), dimension(3) :: p3
	type(vector4_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: m
	integer, dimension(:), allocatable :: pdg
	real(default) :: on_shell_limit
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	real(default) :: probability
	integer :: i

	write (u, "(A)") "* Test output: restricted_subprocesses_4"
	write (u, "(A)") "* Purpose: employ event transform"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)

	call global%select_model (var_str ("SM"))
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	libname = "restricted_subprocesses_4_lib"
	libname_res = "restricted_subprocesses_4_lib_res"
	procname = "restricted_subprocesses_4_p"

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	call integrate_process (procname, global, &
	local_stack = .true., init_only = .true.)

	process => global%process_stack%get_process_ptr (procname)

	call process_instance%init (process)
	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Extract resonance history set"

	call process%extract_resonance_history_set &
	(res_history_set(1), include_trivial=.false., i_component=1)

	write (u, "(A)")
	write (u, "(A)") "* Build resonant-subprocess library"

	call prc_set%init (1)
	call prc_set%fill_resonances (res_history_set(1), 1)

	process_component_def => process%get_component_def_ptr (1)
	call prc_set%create_library (libname_res, global, exist)
	if (.not. exist) then
	call prc_set%add_to_library (1, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end if
	call prc_set%freeze_library (global)
	call prc_set%compile_library (global)

	write (u, "(A)")
	write (u, "(A)") "* Build particle set"
	write (u, "(A)")

	sqrts = global%get_rval (var_str ("sqrts"))
	mw = 80._default ! deliberately slightly different from true mw
	pp = sqrt (sqrts*2 - 4 mw**2) / 2

	allocate (pdg (5), p (5), m (5))
	pdg(1) = -11
	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	m(1) = 0
	pdg(2) = 11
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	m(2) = 0
	pdg(3) = 1
	p3(1) = pp/2
	p3(2) = mw/2
	p3(3) = 0
	p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(3) = 0
	p3(2) = -mw/2
	pdg(4) = -2
	p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(4) = 0
	pdg(5) = 24
	p(5) = vector4_moving (sqrts/2,-pp, 1)
	m(5) = mw

	call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
	call pset%set_momentum (p, m**2)

	write (u, "(A)") "* Fill process instance"
	write (u, "(A)")

	! workflow from event_recalculate
	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1)
	call process_instance%recover &
	(1, 1, update_sqme=.true., recover_phs=.false.)
	call process_instance%evaluate_event_data (weight = 1._default)

	write (u, "(A)") "* Prepare resonant subprocesses"
	write (u, "(A)")

	call prc_set%prepare_process_objects (global)
	call prc_set%prepare_process_instances (global)

	write (u, "(A)") "* Fill trivial event transform (deliberately w/o color)"
	write (u, "(A)")

	call evt_trivial%connect (process_instance, model)
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize resonance-insertion event transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%connect (process_instance, model)
	call prc_set%connect_transform (evt_resonance)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Compute probabilities for applicable resonances"
	write (u, "(A)") " and initialize the process selector"
	write (u, "(A)")

	on_shell_limit = 10._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call evt_resonance%set_on_shell_limit (on_shell_limit)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate resonance-insertion event transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (1, .false.)

	call evt_resonance%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_4"

	end subroutine restricted_subprocesses_4

	@ %def restricted_subprocesses_4
	@
	\subsubsection{Gaussian turnoff}
	Identical to the previous process, except that we apply a Gaussian
	turnoff to the resonance kinematics, which affects the subprocess selector.
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_5, "restricted_subprocesses_5", &
	"event transform with gaussian turnoff", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_5
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_5 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(string_t) :: libname, libname_res
	type(string_t) :: procname
	type(process_component_def_t), pointer :: process_component_def
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	logical :: exist
	type(process_t), pointer :: process
	type(process_instance_t), target :: process_instance
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(resonant_subprocess_set_t) :: prc_set
	type(particle_set_t) :: pset
	real(default) :: sqrts, mw, pp
	real(default), dimension(3) :: p3
	type(vector4_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: m
	integer, dimension(:), allocatable :: pdg
	real(default) :: on_shell_limit
	real(default) :: on_shell_turnoff
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	real(default) :: probability
	integer :: i

	write (u, "(A)") "* Test output: restricted_subprocesses_5"
	write (u, "(A)") "* Purpose: employ event transform &
	&with gaussian turnoff"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)

	call global%select_model (var_str ("SM"))
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	libname = "restricted_subprocesses_5_lib"
	libname_res = "restricted_subprocesses_5_lib_res"
	procname = "restricted_subprocesses_5_p"

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	call integrate_process (procname, global, &
	local_stack = .true., init_only = .true.)

	process => global%process_stack%get_process_ptr (procname)

	call process_instance%init (process)
	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Extract resonance history set"

	call process%extract_resonance_history_set &
	(res_history_set(1), include_trivial=.false., i_component=1)

	write (u, "(A)")
	write (u, "(A)") "* Build resonant-subprocess library"

	call prc_set%init (1)
	call prc_set%fill_resonances (res_history_set(1), 1)

	process_component_def => process%get_component_def_ptr (1)
	call prc_set%create_library (libname_res, global, exist)
	if (.not. exist) then
	call prc_set%add_to_library (1, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end if
	call prc_set%freeze_library (global)
	call prc_set%compile_library (global)

	write (u, "(A)")
	write (u, "(A)") "* Build particle set"
	write (u, "(A)")

	sqrts = global%get_rval (var_str ("sqrts"))
	mw = 80._default ! deliberately slightly different from true mw
	pp = sqrt (sqrts*2 - 4 mw**2) / 2

	allocate (pdg (5), p (5), m (5))
	pdg(1) = -11
	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	m(1) = 0
	pdg(2) = 11
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	m(2) = 0
	pdg(3) = 1
	p3(1) = pp/2
	p3(2) = mw/2
	p3(3) = 0
	p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(3) = 0
	p3(2) = -mw/2
	pdg(4) = -2
	p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(4) = 0
	pdg(5) = 24
	p(5) = vector4_moving (sqrts/2,-pp, 1)
	m(5) = mw

	call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
	call pset%set_momentum (p, m**2)

	write (u, "(A)") "* Fill process instance"
	write (u, "(A)")

	! workflow from event_recalculate
	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1)
	call process_instance%recover &
	(1, 1, update_sqme=.true., recover_phs=.false.)
	call process_instance%evaluate_event_data (weight = 1._default)

	write (u, "(A)") "* Prepare resonant subprocesses"
	write (u, "(A)")

	call prc_set%prepare_process_objects (global)
	call prc_set%prepare_process_instances (global)

	write (u, "(A)") "* Fill trivial event transform (deliberately w/o color)"
	write (u, "(A)")

	call evt_trivial%connect (process_instance, model)
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize resonance-insertion event transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%connect (process_instance, model)
	call prc_set%connect_transform (evt_resonance)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Compute probabilities for applicable resonances"
	write (u, "(A)") " and initialize the process selector"
	write (u, "(A)")

	on_shell_limit = 10._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", &
	on_shell_limit
	call evt_resonance%set_on_shell_limit (on_shell_limit)

	on_shell_turnoff = 1._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_turnoff =", &
	on_shell_turnoff
	call evt_resonance%set_on_shell_turnoff (on_shell_turnoff)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate resonance-insertion event transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (1, .false.)

	call evt_resonance%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_5"

	end subroutine restricted_subprocesses_5

	@ %def restricted_subprocesses_5
	@
	\subsubsection{Event transform}
	The same process and event again. This time, switch off the background
	contribution, so the selector becomes trivial.
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_6, "restricted_subprocesses_6", &
	"event transform with background switched off", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_6
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_6 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(string_t) :: libname, libname_res
	type(string_t) :: procname
	type(process_component_def_t), pointer :: process_component_def
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	logical :: exist
	type(process_t), pointer :: process
	type(process_instance_t), target :: process_instance
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(resonant_subprocess_set_t) :: prc_set
	type(particle_set_t) :: pset
	real(default) :: sqrts, mw, pp
	real(default), dimension(3) :: p3
	type(vector4_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: m
	integer, dimension(:), allocatable :: pdg
	real(default) :: on_shell_limit
	real(default) :: background_factor
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	real(default) :: probability
	integer :: i

	write (u, "(A)") "* Test output: restricted_subprocesses_6"
	write (u, "(A)") "* Purpose: employ event transform &
	&with background switched off"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)

	call global%select_model (var_str ("SM"))
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	libname = "restricted_subprocesses_6_lib"
	libname_res = "restricted_subprocesses_6_lib_res"
	procname = "restricted_subprocesses_6_p"

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	call integrate_process (procname, global, &
	local_stack = .true., init_only = .true.)

	process => global%process_stack%get_process_ptr (procname)

	call process_instance%init (process)
	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Extract resonance history set"

	call process%extract_resonance_history_set &
	(res_history_set(1), include_trivial=.false., i_component=1)

	write (u, "(A)")
	write (u, "(A)") "* Build resonant-subprocess library"

	call prc_set%init (1)
	call prc_set%fill_resonances (res_history_set(1), 1)

	process_component_def => process%get_component_def_ptr (1)
	call prc_set%create_library (libname_res, global, exist)
	if (.not. exist) then
	call prc_set%add_to_library (1, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end if
	call prc_set%freeze_library (global)
	call prc_set%compile_library (global)

	write (u, "(A)")
	write (u, "(A)") "* Build particle set"
	write (u, "(A)")

	sqrts = global%get_rval (var_str ("sqrts"))
	mw = 80._default ! deliberately slightly different from true mw
	pp = sqrt (sqrts*2 - 4 mw**2) / 2

	allocate (pdg (5), p (5), m (5))
	pdg(1) = -11
	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	m(1) = 0
	pdg(2) = 11
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	m(2) = 0
	pdg(3) = 1
	p3(1) = pp/2
	p3(2) = mw/2
	p3(3) = 0
	p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(3) = 0
	p3(2) = -mw/2
	pdg(4) = -2
	p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(4) = 0
	pdg(5) = 24
	p(5) = vector4_moving (sqrts/2,-pp, 1)
	m(5) = mw

	call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
	call pset%set_momentum (p, m**2)

	write (u, "(A)") "* Fill process instance"
	write (u, "(A)")

	! workflow from event_recalculate
	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1)
	call process_instance%recover &
	(1, 1, update_sqme=.true., recover_phs=.false.)
	call process_instance%evaluate_event_data (weight = 1._default)

	write (u, "(A)") "* Prepare resonant subprocesses"
	write (u, "(A)")

	call prc_set%prepare_process_objects (global)
	call prc_set%prepare_process_instances (global)

	write (u, "(A)") "* Fill trivial event transform (deliberately w/o color)"
	write (u, "(A)")

	call evt_trivial%connect (process_instance, model)
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize resonance-insertion event transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%connect (process_instance, model)
	call prc_set%connect_transform (evt_resonance)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Compute probabilities for applicable resonances"
	write (u, "(A)") " and initialize the process selector"
	write (u, "(A)")

	on_shell_limit = 10._default
	write (u, "(1x,A,1x," // FMT_10 // ")") &
	"on_shell_limit =", on_shell_limit
	call evt_resonance%set_on_shell_limit (on_shell_limit)

	background_factor = 0
	write (u, "(1x,A,1x," // FMT_10 // ")") &
	"background_factor =", background_factor
	call evt_resonance%set_background_factor (background_factor)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate resonance-insertion event transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (1, .false.)

	call evt_resonance%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_6"

	end subroutine restricted_subprocesses_6

	@ %def restricted_subprocesses_6
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Simulation}
	This module manages simulation: event generation and reading/writing of event
	files. The [[simulation]] object is intended to be used (via a pointer)
	outside of \whizard, if events are generated individually by an external
	driver.
	<<[[simulations.f90]]>>=
	<<File header>>

	module simulations

	<<Use mpi f08>>
	<<Use kinds>>
	<<Use strings>>
	use sm_qcd
	use model_data
	use particles
	use rng_base
	use selectors
	use process_libraries, only: process_library_t
	use process_libraries, only: process_component_def_t
	use prc_core
	use process
	use event_base
	use event_handles, only: event_handle_t
	use events
	use event_transforms
	use eio_data
	use eio_base
	use rt_data

	use event_streams
	use restricted_subprocesses, only: resonant_subprocess_set_t
	use restricted_subprocesses, only: get_libname_res


	<<Standard module head>>

	<<Simulations: public>>

	<<Simulations: types>>

	<<Simulations: interfaces>>

	interface
	<<Simulations: sub interfaces>>
	end interface

	end module simulations
	@ %def simulations
	@
	<<[[simulations_sub.f90]]>>=
	<<File header>>

	submodule (simulations) simulations_s

	<<Use mpi f08>>
	<<Use debug>>
	use io_units
	use format_utils, only: write_separator
	use format_defs, only: FMT_15, FMT_19
	use numeric_utils
	use string_utils, only: str
	use diagnostics
	use os_interface
	use md5
	use variables, only: var_list_t
	use eval_trees
	use flavors
	use state_matrices, only: FM_IGNORE_HELICITY
	use beam_structures, only: beam_structure_t
	use beams
	use rng_stream, only: rng_stream_t
	use resonances, only: resonance_history_set_t
	! TODO: (bcn 2016-09-13) should be ideally only pcm_base
	use pcm, only: pcm_nlo_t, pcm_nlo_workspace_t
	! TODO: (bcn 2016-09-13) details of process config should not be necessary here
	use process_config, only: COMP_REAL_FIN, COMP_MASTER, COMP_REAL, &
	COMP_REAL_SING
	use instances
	use shower
	use evt_nlo

	use dispatch_beams, only: dispatch_qcd
	use dispatch_rng, only: dispatch_rng_factory
	use dispatch_rng, only: update_rng_seed_in_var_list
	use dispatch_me_methods, only: dispatch_core_update, dispatch_core_restore
	use dispatch_transforms, only: dispatch_evt_isr_epa_handler
	use dispatch_transforms, only: dispatch_evt_resonance
	use dispatch_transforms, only: dispatch_evt_decay
	use dispatch_transforms, only: dispatch_evt_shower
	use dispatch_transforms, only: dispatch_evt_hadrons
	use dispatch_transforms, only: dispatch_evt_nlo

	use integrations
	!!! Intel oneAPI 2022/23 regression workaround
	use process_libraries, only: process_library_t
	use process_libraries, only: process_component_def_t
	use event_handles, only: event_handle_t

	implicit none

	contains

	<<Simulations: procedures>>

	end submodule simulations_s

	@ %def simulations_s
	@
	\subsection{Event counting}
	In this object we collect statistical information about an event
	sample or sub-sample.
	<<Simulations: types>>=
	type :: counter_t
	integer :: total = 0
	integer :: generated = 0
	integer :: read = 0
	integer :: positive = 0
	integer :: negative = 0
	integer :: zero = 0
	integer :: excess = 0
	integer :: dropped = 0
	real(default) :: max_excess = 0
	real(default) :: sum_excess = 0
	logical :: reproduce_xsection = .false.
	real(default) :: mean = 0
	real(default) :: varsq = 0
	integer :: nlo_weight_counter = 0
	contains
	<<Simulations: counter: TBP>>
	end type counter_t

	@ %def simulation_counter_t
	@ Output.
	<<Simulations: counter: TBP>>=
	procedure :: write => counter_write
	<<Simulations: sub interfaces>>=
	module subroutine counter_write (counter, unit)
	class(counter_t), intent(in) :: counter
	integer, intent(in), optional :: unit
	end subroutine counter_write
	<<Simulations: procedures>>=
	module subroutine counter_write (counter, unit)
	class(counter_t), intent(in) :: counter
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	1 format (3x,A,I0)
	2 format (5x,A,I0)
	3 format (5x,A,ES19.12)
	write (u, 1) "Events total = ", counter%total
	write (u, 2) "generated = ", counter%generated
	write (u, 2) "read = ", counter%read
	write (u, 2) "positive weight = ", counter%positive
	write (u, 2) "negative weight = ", counter%negative
	write (u, 2) "zero weight = ", counter%zero
	write (u, 2) "excess weight = ", counter%excess
	if (counter%excess /= 0) then
	write (u, 3) "max excess = ", counter%max_excess
	write (u, 3) "avg excess = ", counter%sum_excess / counter%total
	end if
	write (u, 1) "Events dropped = ", counter%dropped
	end subroutine counter_write

	@ %def counter_write
	@ This is a screen message: if there was an excess, display statistics.
	<<Simulations: counter: TBP>>=
	procedure :: show_excess => counter_show_excess
	<<Simulations: sub interfaces>>=
	module subroutine counter_show_excess (counter)
	class(counter_t), intent(in) :: counter
	end subroutine counter_show_excess
	<<Simulations: procedures>>=
	module subroutine counter_show_excess (counter)
	class(counter_t), intent(in) :: counter
	if (counter%excess > 0) then
	write (msg_buffer, "(A,1x,I0,1x,A,1x,'(',F7.3,' %)')") &
	"Encountered events with excess weight:", counter%excess, &
	"events", 100 * counter%excess / real (counter%total)
	call msg_warning ()
	write (msg_buffer, "(A,ES10.3)") &
	"Maximum excess weight =", counter%max_excess
	call msg_message ()
	write (msg_buffer, "(A,ES10.3)") &
	"Average excess weight =", counter%sum_excess / counter%total
	call msg_message ()
	end if
	end subroutine counter_show_excess

	@ %def counter_show_excess
	@ If events have been dropped during simulation of weighted events,
	issue a message here.
	If a fraction [[n_dropped / n_total]] of the events fail the cuts, we keep
	generating new ones until we have [[n_total]] events with [[weight > 0]].
	Thus, the total sum of weights will be a fraction of [[n_dropped / n_total]]
	too large. However, we do not know how many events will pass or fail the cuts
	prior to generating them so we leave it to the user to correct for this factor.
	<<Simulations: counter: TBP>>=
	procedure :: show_dropped => counter_show_dropped
	<<Simulations: sub interfaces>>=
	module subroutine counter_show_dropped (counter)
	class(counter_t), intent(in) :: counter
	end subroutine counter_show_dropped
	<<Simulations: procedures>>=
	module subroutine counter_show_dropped (counter)
	class(counter_t), intent(in) :: counter
	if (counter%dropped > 0) then
	write (msg_buffer, "(A,1x,I0,1x,'(',A,1x,I0,')')") &
	"Dropped events (weight zero) =", &
	counter%dropped, "total", counter%dropped + counter%total
	call msg_message ()
	write (msg_buffer, "(A,ES15.8)") &
	"All event weights must be rescaled by f =", &
	real (counter%total, default) &
	/ real (counter%dropped + counter%total, default)
	call msg_warning ()
	end if
	end subroutine counter_show_dropped

	@ %def counter_show_dropped
	@
	<<Simulations: counter: TBP>>=
	procedure :: show_mean_and_variance => counter_show_mean_and_variance
	<<Simulations: sub interfaces>>=
	module subroutine counter_show_mean_and_variance (counter)
	class(counter_t), intent(in) :: counter
	end subroutine counter_show_mean_and_variance
	<<Simulations: procedures>>=
	module subroutine counter_show_mean_and_variance (counter)
	class(counter_t), intent(in) :: counter
	if (counter%reproduce_xsection .and. counter%nlo_weight_counter > 1) then
	print *, "Reconstructed cross-section from event weights: "
	print *, counter%mean, '+-', &
	sqrt (counter%varsq / (counter%nlo_weight_counter - 1))
	end if
	end subroutine counter_show_mean_and_variance

	@ %def counter_show_mean_and_variance
	@ Count an event. The weight and event source are optional; by
	default we assume that the event has been generated and has positive
	weight.

	The optional integer [[n_dropped]] counts weighted events with weight
	zero that were encountered while generating the current event, but
	dropped (because of their zero weight). Accumulating this number
	allows for renormalizing event weight sums in histograms, after the
	generation step has been completed.
	<<Simulations: counter: TBP>>=
	procedure :: record => counter_record
	<<Simulations: sub interfaces>>=
	module subroutine counter_record &
	(counter, weight, excess, n_dropped, from_file)
	class(counter_t), intent(inout) :: counter
	real(default), intent(in), optional :: weight, excess
	integer, intent(in), optional :: n_dropped
	logical, intent(in), optional :: from_file
	end subroutine counter_record
	<<Simulations: procedures>>=
	module subroutine counter_record &
	(counter, weight, excess, n_dropped, from_file)
	class(counter_t), intent(inout) :: counter
	real(default), intent(in), optional :: weight, excess
	integer, intent(in), optional :: n_dropped
	logical, intent(in), optional :: from_file
	counter%total = counter%total + 1
	if (present (from_file)) then
	if (from_file) then
	counter%read = counter%read + 1
	else
	counter%generated = counter%generated + 1
	end if
	else
	counter%generated = counter%generated + 1
	end if
	if (present (weight)) then
	if (weight > 0) then
	counter%positive = counter%positive + 1
	else if (weight < 0) then
	counter%negative = counter%negative + 1
	else
	counter%zero = counter%zero + 1
	end if
	else
	counter%positive = counter%positive + 1
	end if
	if (present (excess)) then
	if (excess > 0) then
	counter%excess = counter%excess + 1
	counter%max_excess = max (counter%max_excess, excess)
	counter%sum_excess = counter%sum_excess + excess
	end if
	end if
	if (present (n_dropped)) then
	counter%dropped = counter%dropped + n_dropped
	end if
	end subroutine counter_record

	@ %def counter_record
	<<MPI: Simulations: counter: TBP>>=
	procedure :: allreduce_record => counter_allreduce_record
	<<MPI: Simulations: sub interfaces>>=
	module subroutine counter_allreduce_record (counter)
	class(counter_t), intent(inout) :: counter
	end subroutine counter_allreduce_record
	<<MPI: Simulations: procedures>>=
	module subroutine counter_allreduce_record (counter)
	class(counter_t), intent(inout) :: counter
	integer :: read, generated
	integer :: positive, negative, zero, excess, dropped
	real(default) :: max_excess, sum_excess
	read = counter%read
	generated = counter%generated
	positive = counter%positive
	negative = counter%negative
	zero = counter%zero
	excess = counter%excess
	max_excess = counter%max_excess
	sum_excess = counter%sum_excess
	dropped = counter%dropped
	call MPI_ALLREDUCE (read, counter%read, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
	call MPI_ALLREDUCE (generated, counter%generated, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
	call MPI_ALLREDUCE (positive, counter%positive, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
	call MPI_ALLREDUCE (negative, counter%negative, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
	call MPI_ALLREDUCE (zero, counter%zero, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
	call MPI_ALLREDUCE (excess, counter%excess, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
	call MPI_ALLREDUCE (max_excess, counter%max_excess, 1, MPI_DOUBLE_PRECISION, MPI_MAX, MPI_COMM_WORLD)
	call MPI_ALLREDUCE (sum_excess, counter%sum_excess, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD)
	call MPI_ALLREDUCE (dropped, counter%dropped, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD)
	!! \todo{sbrass - Implement allreduce of mean and variance, relevant for weighted events.}
	end subroutine counter_allreduce_record

	@
	<<Simulations: counter: TBP>>=
	procedure :: record_mean_and_variance => &
	counter_record_mean_and_variance
	<<Simulations: sub interfaces>>=
	module subroutine counter_record_mean_and_variance (counter, weight, i_nlo)
	class(counter_t), intent(inout) :: counter
	real(default), intent(in) :: weight
	integer, intent(in) :: i_nlo
	end subroutine counter_record_mean_and_variance
	<<Simulations: procedures>>=
	module subroutine counter_record_mean_and_variance (counter, weight, i_nlo)
	class(counter_t), intent(inout) :: counter
	real(default), intent(in) :: weight
	integer, intent(in) :: i_nlo
	real(default), save :: weight_buffer = 0._default
	integer, save :: nlo_count = 1
	if (.not. counter%reproduce_xsection) return
	if (i_nlo == 1) then
	call flush_weight_buffer (weight_buffer, nlo_count)
	weight_buffer = weight
	nlo_count = 1
	else
	weight_buffer = weight_buffer + weight
	nlo_count = nlo_count + 1
	end if
	contains
	subroutine flush_weight_buffer (w, n_nlo)
	real(default), intent(in) :: w
	integer, intent(in) :: n_nlo
	integer :: n
	real(default) :: mean_new
	counter%nlo_weight_counter = counter%nlo_weight_counter + 1
	!!! Minus 1 to take into account offset from initialization
	n = counter%nlo_weight_counter - 1
	if (n > 0) then
	mean_new = counter%mean + (w / n_nlo - counter%mean) / n
	if (n > 1) &
	counter%varsq = counter%varsq - counter%varsq / (n - 1) + &
	n * (mean_new - counter%mean)**2
	counter%mean = mean_new
	end if
	end subroutine flush_weight_buffer
	end subroutine counter_record_mean_and_variance

	@ %def counter_record_mean_and_variance
	@
	\subsection{Simulation: component sets}
	For each set of process components that share a MCI entry in the
	process configuration, we keep a separate event record.
	<<Simulations: types>>=
	type :: mci_set_t
	private
	integer :: n_components = 0
	integer, dimension(:), allocatable :: i_component
	type(string_t), dimension(:), allocatable :: component_id
	logical :: has_integral = .false.
	real(default) :: integral = 0
	real(default) :: error = 0
	real(default) :: weight_mci = 0
	type(counter_t) :: counter
	contains
	<<Simulations: mci set: TBP>>
	end type mci_set_t

	@ %def mci_set_t
	@ Output.
	<<Simulations: mci set: TBP>>=
	procedure :: write => mci_set_write
	<<Simulations: sub interfaces>>=
	module subroutine mci_set_write (object, unit, pacified)
	class(mci_set_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacified
	end subroutine mci_set_write
	<<Simulations: procedures>>=
	module subroutine mci_set_write (object, unit, pacified)
	class(mci_set_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacified
	logical :: pacify
	integer :: u, i
	u = given_output_unit (unit)
	pacify = .false.; if (present (pacified)) pacify = pacified
	write (u, "(3x,A)") "Components:"
	do i = 1, object%n_components
	write (u, "(5x,I0,A,A,A)") object%i_component(i), &
	": '", char (object%component_id(i)), "'"
	end do
	if (object%has_integral) then
	if (pacify) then
	write (u, "(3x,A," // FMT_15 // ")") "Integral = ", object%integral
	write (u, "(3x,A," // FMT_15 // ")") "Error = ", object%error
	write (u, "(3x,A,F9.6)") "Weight =", object%weight_mci
	else
	write (u, "(3x,A," // FMT_19 // ")") "Integral = ", object%integral
	write (u, "(3x,A," // FMT_19 // ")") "Error = ", object%error
	write (u, "(3x,A,F13.10)") "Weight =", object%weight_mci
	end if
	else
	write (u, "(3x,A)") "Integral = [undefined]"
	end if
	call object%counter%write (u)
	end subroutine mci_set_write

	@ %def mci_set_write
	@ Initialize: Get the indices and names for the process components
	that will contribute to this set.
	<<Simulations: mci set: TBP>>=
	procedure :: init => mci_set_init
	<<Simulations: sub interfaces>>=
	module subroutine mci_set_init (object, i_mci, process)
	class(mci_set_t), intent(out) :: object
	integer, intent(in) :: i_mci
	type(process_t), intent(in), target :: process
	end subroutine mci_set_init
	<<Simulations: procedures>>=
	module subroutine mci_set_init (object, i_mci, process)
	class(mci_set_t), intent(out) :: object
	integer, intent(in) :: i_mci
	type(process_t), intent(in), target :: process
	integer :: i
	call process%get_i_component (i_mci, object%i_component)
	object%n_components = size (object%i_component)
	allocate (object%component_id (object%n_components))
	do i = 1, size (object%component_id)
	object%component_id(i) = &
	process%get_component_id (object%i_component(i))
	end do
	if (process%has_integral (i_mci)) then
	object%integral = process%get_integral (i_mci)
	object%error = process%get_error (i_mci)
	object%has_integral = .true.
	end if
	end subroutine mci_set_init

	@ %def mci_set_init
	@
	\subsection{Process-core Safe}
	This is an object that temporarily holds a process core object. We
	need this while rescanning a process with modified parameters. After
	the rescan, we want to restore the original state.
	<<Simulations: types>>=
	type :: core_safe_t
	class(prc_core_t), allocatable :: core
	end type core_safe_t

	@ %def core_safe_t
	@
	\subsection{Process Object}
	The simulation works on process objects. This subroutine makes a
	process object available for simulation. The process is in the
	process stack. [[use_process]] implies that the process should
	already exist as an object in the process stack. If integration is
	not yet done, do it. Any generated process object should be put on
	the global stack, if it is separate from the local one.
	<<Simulations: procedures>>=
	subroutine prepare_process &
	(process, process_id, use_process, integrate, local, global)
	type(process_t), pointer, intent(out) :: process
	type(string_t), intent(in) :: process_id
	logical, intent(in) :: use_process, integrate
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	type(rt_data_t), pointer :: current
	if (debug_on) call msg_debug (D_CORE, "prepare_process")
	if (debug_on) call msg_debug (D_CORE, "global present", present (global))
	if (present (global)) then
	current => global
	else
	current => local
	end if
	process => current%process_stack%get_process_ptr (process_id)
	if (debug_on) call msg_debug (D_CORE, "use_process", use_process)
	if (debug_on) call msg_debug (D_CORE, "associated process", associated (process))
	if (use_process .and. .not. associated (process)) then
	if (integrate) then
	call msg_message ("Simulate: process '" &
	// char (process_id) // "' needs integration")
	else
	call msg_message ("Simulate: process '" &
	// char (process_id) // "' needs initialization")
	end if
	if (present (global)) then
	call integrate_process (process_id, local, global, &
	init_only = .not. integrate)
	else
	call integrate_process (process_id, local, &
	local_stack = .true., init_only = .not. integrate)
	end if
	if (signal_is_pending ()) return
	process => current%process_stack%get_process_ptr (process_id)
	if (associated (process)) then
	if (integrate) then
	call msg_message ("Simulate: integration done")
	call current%process_stack%fill_result_vars (process_id)
	else
	call msg_message ("Simulate: process initialization done")
	end if
	else
	call msg_fatal ("Simulate: process '" &
	// char (process_id) // "' could not be initialized: aborting")
	end if
	else if (.not. associated (process)) then
	if (present (global)) then
	call integrate_process (process_id, local, global, &
	init_only = .true.)
	else
	call integrate_process (process_id, local, &
	local_stack = .true., init_only = .true.)
	end if
	process => current%process_stack%get_process_ptr (process_id)
	call msg_message &
	("Simulate: process '" &
	// char (process_id) // "': enabled for rescan only")
	end if
	end subroutine prepare_process

	@ %def prepare_process
	@
	\subsection{Simulation-entry object}
	For each process that we consider for event generation, we need a
	separate entry. The entry separately records the process ID and run ID. The
	[[weight_mci]] array is used for selecting a component set (which
	shares an MCI record inside the process container) when generating an
	event for the current process.

	The simulation entry is an extension of the [[event_t]] event record.
	This core object contains configuration data, pointers to the process
	and process instance, the expressions, flags and values that are
	evaluated at runtime, and the resulting particle set.

	The entry explicitly allocates the [[process_instance]], which becomes
	the process-specific workspace for the event record.

	If entries with differing environments are present simultaneously, we
	may need to switch QCD parameters and/or the model event by event. In
	this case, the [[qcd]] and/or [[model]] components are present.

	For the purpose of NLO events, [[entry_t]] contains a pointer list
	to other simulation-entries. This is due to the fact that we have to
	associate an event for each component of the fixed order simulation,
	i.e. one $N$-particle event and $N_\text{phs}$ $N+1$-particle events.
	However, all entries share the same event transforms.
	<<Simulations: types>>=
	type, extends (event_t) :: entry_t
	private
	type(string_t) :: process_id
	type(string_t) :: library
	type(string_t) :: run_id
	logical :: has_integral = .false.
	real(default) :: integral = 0
	real(default) :: error = 0
	real(default) :: process_weight = 0
	logical :: valid = .false.
	type(counter_t) :: counter
	integer :: n_in = 0
	integer :: n_mci = 0
	type(mci_set_t), dimension(:), allocatable :: mci_sets
	type(selector_t) :: mci_selector
	logical :: has_resonant_subprocess_set = .false.
	type(resonant_subprocess_set_t) :: resonant_subprocess_set
	type(core_safe_t), dimension(:), allocatable :: core_safe
	class(model_data_t), pointer :: model => null ()
	type(qcd_t) :: qcd
	type(entry_t), pointer :: first => null ()
	type(entry_t), pointer :: next => null ()
	class(evt_t), pointer :: evt_powheg => null ()
	contains
	<<Simulations: entry: TBP>>
	end type entry_t

	@ %def entry_t
	@ Output. Write just the configuration, the event is written by a
	separate routine.

	The [[verbose]] option is unused, it is required by the interface of
	the base-object method.
	<<Simulations: entry: TBP>>=
	procedure :: write_config => entry_write_config
	<<Simulations: sub interfaces>>=
	module subroutine entry_write_config (object, unit, pacified)
	class(entry_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacified
	end subroutine entry_write_config
	<<Simulations: procedures>>=
	module subroutine entry_write_config (object, unit, pacified)
	class(entry_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacified
	logical :: pacify
	integer :: u, i
	u = given_output_unit (unit)
	pacify = .false.; if (present (pacified)) pacify = pacified
	write (u, "(3x,A,A,A)") "Process = '", char (object%process_id), "'"
	write (u, "(3x,A,A,A)") "Library = '", char (object%library), "'"
	write (u, "(3x,A,A,A)") "Run = '", char (object%run_id), "'"
	write (u, "(3x,A,L1)") "is valid = ", object%valid
	if (object%has_integral) then
	if (pacify) then
	write (u, "(3x,A," // FMT_15 // ")") "Integral = ", object%integral
	write (u, "(3x,A," // FMT_15 // ")") "Error = ", object%error
	write (u, "(3x,A,F9.6)") "Weight =", object%process_weight
	else
	write (u, "(3x,A," // FMT_19 // ")") "Integral = ", object%integral
	write (u, "(3x,A," // FMT_19 // ")") "Error = ", object%error
	write (u, "(3x,A,F13.10)") "Weight =", object%process_weight
	end if
	else
	write (u, "(3x,A)") "Integral = [undefined]"
	end if
	write (u, "(3x,A,I0)") "MCI sets = ", object%n_mci
	call object%counter%write (u)
	do i = 1, size (object%mci_sets)
	write (u, "(A)")
	write (u, "(1x,A,I0,A)") "MCI set #", i, ":"
	call object%mci_sets(i)%write (u, pacified)
	end do
	if (object%resonant_subprocess_set%is_active ()) then
	write (u, "(A)")
	call object%write_resonant_subprocess_data (u)
	end if
	if (allocated (object%core_safe)) then
	do i = 1, size (object%core_safe)
	write (u, "(1x,A,I0,A)") "Saved process-component core #", i, ":"
	call object%core_safe(i)%core%write (u)
	end do
	end if
	end subroutine entry_write_config

	@ %def entry_write_config
	@ Finalizer. The [[instance]] pointer component of the [[event_t]]
	base type points to a target which we did explicitly allocate in the
	[[entry_init]] procedure. Therefore, we finalize and explicitly
	deallocate it here. Then we call the finalizer of the base type.
	<<Simulations: entry: TBP>>=
	procedure :: final => entry_final
	<<Simulations: sub interfaces>>=
	module subroutine entry_final (object)
	class(entry_t), intent(inout) :: object
	end subroutine entry_final
	<<Simulations: procedures>>=
	module subroutine entry_final (object)
	class(entry_t), intent(inout) :: object
	integer :: i
	if (associated (object%instance)) then
	do i = 1, object%n_mci
	call object%instance%final_simulation (i)
	end do
	call object%instance%final ()
	deallocate (object%instance)
	end if
	call object%event_t%final ()
	end subroutine entry_final

	@ %def entry_final
	@ Copy the content of an entry into another one, except for the next-pointer
	<<Simulations: entry: TBP>>=
	procedure :: copy_entry => entry_copy_entry
	<<Simulations: sub interfaces>>=
	module subroutine entry_copy_entry (entry1, entry2)
	class(entry_t), intent(in), target :: entry1
	type(entry_t), intent(inout), target :: entry2
	end subroutine entry_copy_entry
	<<Simulations: procedures>>=
	module subroutine entry_copy_entry (entry1, entry2)
	class(entry_t), intent(in), target :: entry1
	type(entry_t), intent(inout), target :: entry2
	call entry1%event_t%clone (entry2%event_t)
	entry2%process_id = entry1%process_id
	entry2%library = entry1%library
	entry2%run_id = entry1%run_id
	entry2%has_integral = entry1%has_integral
	entry2%integral = entry1%integral
	entry2%error = entry1%error
	entry2%process_weight = entry1%process_weight
	entry2%valid = entry1%valid
	entry2%counter = entry1%counter
	entry2%n_in = entry1%n_in
	entry2%n_mci = entry1%n_mci
	if (allocated (entry1%mci_sets)) then
	allocate (entry2%mci_sets (size (entry1%mci_sets)))
	entry2%mci_sets = entry1%mci_sets
	end if
	entry2%mci_selector = entry1%mci_selector
	if (allocated (entry1%core_safe)) then
	allocate (entry2%core_safe (size (entry1%core_safe)))
	entry2%core_safe = entry1%core_safe
	end if
	entry2%model => entry1%model
	entry2%qcd = entry1%qcd
	end subroutine entry_copy_entry

	@ %def entry_copy_entry
	@
	\subsubsection{Simulation-entry initialization}
	Search for a process entry and allocate a process
	instance as an anonymous object, temporarily accessible via the
	[[process_instance]] pointer. Assign data by looking at the process
	object and at the environment.

	If [[n_alt]] is set, we prepare for additional alternate sqme and weight
	entries.

	The [[compile]] flag is only false if we do not need the Whizard
	process at all, just its definition. In that case, we skip process
	initialization.

	Otherwise, and if the process object is not found initially: if
	[[integrate]] is set, attempt an integration pass and try again.
	Otherwise, just initialize the object.

	If [[generate]] is set, prepare the MCI objects for generating new events.
	For pure rescanning, this is not necessary.

	If [[resonance_history]] is set, we create a separate process library
	which contains all possible restricted subprocesses with distinct
	resonance histories. These processes will not be integrated, but
	their matrix element codes are used for determining probabilities of
	resonance histories. Note that this can work only if the process
	method is OMega, and the phase-space method is 'wood'.

	When done, we assign the [[instance]] and [[process]] pointers of the
	base type by the [[connect]] method, so we can reference them later.

	TODO: In case of NLO event generation, copying the configuration from the
	master process is rather intransparent. For instance, we override the process
	var list by the global var list.
	<<Simulations: entry: TBP>>=
	procedure :: init => entry_init
	<<Simulations: sub interfaces>>=
	module subroutine entry_init &
	(entry, process_id, &
	use_process, integrate, generate, update_sqme, &
	support_resonance_history, &
	local, global, n_alt)
	class(entry_t), intent(inout), target :: entry
	type(string_t), intent(in) :: process_id
	logical, intent(in) :: use_process, integrate, generate, update_sqme
	logical, intent(in) :: support_resonance_history
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	integer, intent(in), optional :: n_alt
	end subroutine entry_init
	<<Simulations: procedures>>=
	module subroutine entry_init &
	(entry, process_id, &
	use_process, integrate, generate, update_sqme, &
	support_resonance_history, &
	local, global, n_alt)
	class(entry_t), intent(inout), target :: entry
	type(string_t), intent(in) :: process_id
	logical, intent(in) :: use_process, integrate, generate, update_sqme
	logical, intent(in) :: support_resonance_history
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	integer, intent(in), optional :: n_alt
	type(process_t), pointer :: process, master_process
	type(process_instance_t), pointer :: process_instance
	type(process_library_t), pointer :: prclib_saved
	integer :: i
	logical :: res_include_trivial
	logical :: combined_integration
	integer :: selected_mci
	selected_mci = 0
	if (debug_on) call msg_debug (D_CORE, "entry_init")
	if (debug_on) call msg_debug (D_CORE, "process_id", process_id)
	call prepare_process &
	(master_process, process_id, use_process, integrate, local, global)
	if (signal_is_pending ()) return

	if (associated (master_process)) then
	if (.not. master_process%has_matrix_element ()) then
	entry%has_integral = .true.
	entry%process_id = process_id
	entry%valid = .false.
	return
	end if
	else
	call entry%basic_init (local%var_list)
	entry%has_integral = .false.
	entry%process_id = process_id
	call entry%import_process_def_characteristics (local%prclib, process_id)
	entry%valid = .true.
	return
	end if

	call entry%basic_init (local%var_list, n_alt)

	entry%process_id = process_id
	if (generate .or. integrate) then
	entry%run_id = master_process%get_run_id ()
	process => master_process
	else
	call local%set_log (var_str ("?rebuild_phase_space"), &
	.false., is_known = .true.)
	call local%set_log (var_str ("?check_phs_file"), &
	.false., is_known = .true.)
	call local%set_log (var_str ("?rebuild_grids"), &
	.false., is_known = .true.)
	entry%run_id = &
	local%var_list%get_sval (var_str ("$run_id"))
	if (update_sqme) then
	call prepare_local_process (process, process_id, local)
	else
	process => master_process
	end if
	end if

	call entry%import_process_characteristics (process)

	allocate (entry%mci_sets (entry%n_mci))
	do i = 1, size (entry%mci_sets)
	call entry%mci_sets(i)%init (i, master_process)
	end do

	call entry%import_process_results (master_process)
	call entry%prepare_expressions (local)

	if (process%is_nlo_calculation ()) then
	call process%init_nlo_settings (global%var_list)
	end if
	combined_integration = local%get_lval (var_str ("?combined_nlo_integration"))
	if (.not. combined_integration) &
	selected_mci = process%extract_active_component_mci ()
	call prepare_process_instance (process_instance, process, local%model, &
	local = local)

	if (generate) then
	if (selected_mci > 0) then
	call process%prepare_simulation (selected_mci)
	call process_instance%init_simulation (selected_mci, entry%config%safety_factor, &
	local%get_lval (var_str ("?keep_failed_events")))
	else
	do i = 1, entry%n_mci
	call process%prepare_simulation (i)
	call process_instance%init_simulation (i, entry%config%safety_factor, &
	local%get_lval (var_str ("?keep_failed_events")))
	end do
	end if
	end if

	if (support_resonance_history) then
	prclib_saved => local%prclib
	call entry%setup_resonant_subprocesses (local, process)
	if (entry%has_resonant_subprocess_set) then
	if (signal_is_pending ()) return
	call entry%compile_resonant_subprocesses (local)
	if (signal_is_pending ()) return
	call entry%prepare_resonant_subprocesses (local, global)
	if (signal_is_pending ()) return
	call entry%prepare_resonant_subprocess_instances (local)
	end if
	if (signal_is_pending ()) return
	if (associated (prclib_saved)) call local%update_prclib (prclib_saved)
	end if

	call entry%setup_event_transforms (process, local)

	call dispatch_qcd (entry%qcd, local%get_var_list_ptr (), local%os_data)

	call entry%connect_qcd ()

	if (present (global)) then
	call entry%connect (process_instance, local%model, global%process_stack)
	else
	call entry%connect (process_instance, local%model, local%process_stack)
	end if
	call entry%setup_expressions ()

	entry%model => process%get_model_ptr ()

	entry%valid = .true.

	end subroutine entry_init

	@ %def entry_init
	@
	<<Simulations: entry: TBP>>=
	procedure :: set_active_real_components => entry_set_active_real_components
	<<Simulations: sub interfaces>>=
	module subroutine entry_set_active_real_components (entry)
	class(entry_t), intent(inout) :: entry
	end subroutine entry_set_active_real_components
	<<Simulations: procedures>>=
	module subroutine entry_set_active_real_components (entry)
	class(entry_t), intent(inout) :: entry
	integer :: i_active_real
	select type (pcm => entry%instance%pcm)
	class is (pcm_nlo_t)
	i_active_real = entry%instance%get_real_of_mci ()
	if (debug_on) call msg_debug2 (D_CORE, "i_active_real", i_active_real)
	if (associated (entry%evt_powheg)) then
	select type (evt => entry%evt_powheg)
	type is (evt_shower_t)
	if (entry%process%get_component_type(i_active_real) == &
	COMP_REAL_FIN) then
	if (debug_on) call msg_debug &
	(D_CORE, "Disabling Powheg matching for ", i_active_real)
	call evt%disable_powheg_matching ()
	else
	if (debug_on) call msg_debug &
	(D_CORE, "Enabling Powheg matching for ", i_active_real)
	call evt%enable_powheg_matching ()
	end if
	class default
	call msg_fatal ("powheg-evt should be evt_shower_t!")
	end select
	end if
	end select
	end subroutine entry_set_active_real_components

	@ %def entry_set_active_real_components
	@ Part of simulation-entry initialization: set up a process object for
	local use.
	<<Simulations: procedures>>=
	subroutine prepare_local_process (process, process_id, local)
	type(process_t), pointer, intent(inout) :: process
	type(string_t), intent(in) :: process_id
	type(rt_data_t), intent(inout), target :: local
	type(integration_t) :: intg
	call intg%create_process (process_id)
	call intg%init_process (local)
	call intg%setup_process (local, verbose=.false.)
	process => intg%get_process_ptr ()
	end subroutine prepare_local_process

	@ %def prepare_local_process
	@ Part of simulation-entry initialization: set up a process instance
	matching the selected process object.

	The model that we can provide as an extra argument can modify particle
	settings (polarization) in the density matrices that will be constructed. It
	does not affect parameters.
	<<Restricted subprocesses: sub interfaces>>=
	<<Simulations: procedures>>=
	subroutine prepare_process_instance &
	(process_instance, process, model, local)
	type(process_instance_t), pointer, intent(inout) :: process_instance
	type(process_t), intent(inout), target :: process
	class(model_data_t), intent(in), optional :: model
	type(rt_data_t), intent(in), optional, target :: local
	allocate (process_instance)
	call process_instance%init (process)
	if (process%is_nlo_calculation ()) then
	select type (pcm_work => process_instance%pcm_work)
	type is (pcm_nlo_workspace_t)
	select type (pcm => process_instance%pcm)
	type is (pcm_nlo_t)
	if (.not. pcm%settings%combined_integration) &
	call pcm_work%set_radiation_event ()
	if (pcm%settings%fixed_order_nlo) &
	call pcm_work%set_fixed_order_event_mode ()
	end select
	end select
	call process%prepare_any_external_code ()
	end if
	call process_instance%setup_event_data (model)
	end subroutine prepare_process_instance

	@ %def prepare_process_instance
	@ Part of simulation-entry initialization: query the
	process for basic information.
	<<Simulations: entry: TBP>>=
	procedure, private :: import_process_characteristics &
	=> entry_import_process_characteristics
	<<Simulations: sub interfaces>>=
	module subroutine entry_import_process_characteristics (entry, process)
	class(entry_t), intent(inout) :: entry
	type(process_t), intent(in), target :: process
	end subroutine entry_import_process_characteristics
	<<Simulations: procedures>>=
	module subroutine entry_import_process_characteristics (entry, process)
	class(entry_t), intent(inout) :: entry
	type(process_t), intent(in), target :: process
	entry%library = process%get_library_name ()
	entry%n_in = process%get_n_in ()
	entry%n_mci = process%get_n_mci ()
	end subroutine entry_import_process_characteristics

	@ %def entry_import_process_characteristics
	@ This is the alternative form which applies if there is no process
	entry, but just a process definition which we take from the provided
	[[prclib]] definition library.
	<<Simulations: entry: TBP>>=
	procedure, private :: import_process_def_characteristics &
	=> entry_import_process_def_characteristics
	<<Simulations: sub interfaces>>=
	module subroutine entry_import_process_def_characteristics &
	(entry, prclib, id)
	class(entry_t), intent(inout) :: entry
	type(process_library_t), intent(in), target :: prclib
	type(string_t), intent(in) :: id
	end subroutine entry_import_process_def_characteristics
	<<Simulations: procedures>>=
	module subroutine entry_import_process_def_characteristics (entry, prclib, id)
	class(entry_t), intent(inout) :: entry
	type(process_library_t), intent(in), target :: prclib
	type(string_t), intent(in) :: id
	entry%library = prclib%get_name ()
	entry%n_in = prclib%get_n_in (id)
	end subroutine entry_import_process_def_characteristics

	@ %def entry_import_process_def_characteristics
	@ Part of simulation-entry initialization: query the
	process for integration results.
	<<Simulations: entry: TBP>>=
	procedure, private :: import_process_results &
	=> entry_import_process_results
	<<Simulations: sub interfaces>>=
	module subroutine entry_import_process_results (entry, process)
	class(entry_t), intent(inout) :: entry
	type(process_t), intent(in), target :: process
	end subroutine entry_import_process_results
	<<Simulations: procedures>>=
	module subroutine entry_import_process_results (entry, process)
	class(entry_t), intent(inout) :: entry
	type(process_t), intent(in), target :: process
	if (process%has_integral ()) then
	entry%integral = process%get_integral ()
	entry%error = process%get_error ()
	call entry%set_sigma (entry%integral)
	entry%has_integral = .true.
	end if
	end subroutine entry_import_process_results

	@ %def entry_import_process_results
	@ Part of simulation-entry initialization: create expression factory
	objects and store them.
	<<Simulations: entry: TBP>>=
	procedure, private :: prepare_expressions &
	=> entry_prepare_expressions
	<<Simulations: sub interfaces>>=
	module subroutine entry_prepare_expressions (entry, local)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(in), target :: local
	end subroutine entry_prepare_expressions
	<<Simulations: procedures>>=
	module subroutine entry_prepare_expressions (entry, local)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(in), target :: local
	type(eval_tree_factory_t) :: expr_factory
	call expr_factory%init (local%pn%selection_lexpr)
	call entry%set_selection (expr_factory)
	call expr_factory%init (local%pn%reweight_expr)
	call entry%set_reweight (expr_factory)
	call expr_factory%init (local%pn%analysis_lexpr)
	call entry%set_analysis (expr_factory)
	end subroutine entry_prepare_expressions

	@ %def entry_prepare_expressions
	@
	\subsubsection{Extra (NLO) entries}
	Initializes the list of additional NLO entries. The routine gets the
	information about how many entries to associate from [[region_data]].
	<<Simulations: entry: TBP>>=
	procedure :: setup_additional_entries => entry_setup_additional_entries
	<<Simulations: sub interfaces>>=
	module subroutine entry_setup_additional_entries (entry)
	class(entry_t), intent(inout), target :: entry
	end subroutine entry_setup_additional_entries
	<<Simulations: procedures>>=
	module subroutine entry_setup_additional_entries (entry)
	class(entry_t), intent(inout), target :: entry
	type(entry_t), pointer :: current_entry
	integer :: i, n_phs
	type(evt_nlo_t), pointer :: evt
	integer :: mode
	evt => null ()
	select type (pcm => entry%instance%pcm)
	type is (pcm_nlo_t)
	n_phs = pcm%region_data%n_phs
	end select
	select type (entry)
	type is (entry_t)
	current_entry => entry
	current_entry%first => entry
	call get_nlo_evt_ptr (current_entry, evt, mode)
	if (mode > EVT_NLO_SEPARATE_BORNLIKE) then
	allocate (evt%particle_set_nlo (n_phs + 1))
	evt%event_deps%n_phs = n_phs
	evt%qcd = entry%qcd
	do i = 1, n_phs
	allocate (current_entry%next)
	current_entry%next%first => current_entry%first
	current_entry => current_entry%next
	call entry%copy_entry (current_entry)
	current_entry%i_event = i
	end do
	else
	allocate (evt%particle_set_nlo (1))
	end if
	end select
	contains
	subroutine get_nlo_evt_ptr (entry, evt, mode)
	type(entry_t), intent(in), target :: entry
	type(evt_nlo_t), intent(out), pointer :: evt
	integer, intent(out) :: mode
	class(evt_t), pointer :: current_evt
	evt => null ()
	current_evt => entry%transform_first
	do
	select type (current_evt)
	type is (evt_nlo_t)
	evt => current_evt
	mode = evt%mode
	exit
	end select
	if (associated (current_evt%next)) then
	current_evt => current_evt%next
	else
	call msg_fatal ("evt_nlo not in list of event transforms")
	end if
	end do
	end subroutine get_nlo_evt_ptr
	end subroutine entry_setup_additional_entries

	@ %def entry_setup_additional_entries
	@
	<<Simulations: entry: TBP>>=
	procedure :: get_first => entry_get_first
	<<Simulations: sub interfaces>>=
	module function entry_get_first (entry) result (entry_out)
	class(entry_t), intent(in), target :: entry
	type(entry_t), pointer :: entry_out
	end function entry_get_first
	<<Simulations: procedures>>=
	module function entry_get_first (entry) result (entry_out)
	class(entry_t), intent(in), target :: entry
	type(entry_t), pointer :: entry_out
	entry_out => null ()
	select type (entry)
	type is (entry_t)
	if (entry%is_nlo ()) then
	entry_out => entry%first
	else
	entry_out => entry
	end if
	end select
	end function entry_get_first

	@ %def entry_get_first
	@
	<<Simulations: entry: TBP>>=
	procedure :: get_next => entry_get_next
	<<Simulations: sub interfaces>>=
	module function entry_get_next (entry) result (next_entry)
	class(entry_t), intent(in) :: entry
	type(entry_t), pointer :: next_entry
	end function entry_get_next
	<<Simulations: procedures>>=
	module function entry_get_next (entry) result (next_entry)
	class(entry_t), intent(in) :: entry
	type(entry_t), pointer :: next_entry
	next_entry => null ()
	if (associated (entry%next)) then
	next_entry => entry%next
	else
	call msg_fatal ("Get next entry: No next entry")
	end if
	end function entry_get_next

	@ %def entry_get_next
	@
	<<Simulations: entry: TBP>>=
	procedure :: count_nlo_entries => entry_count_nlo_entries
	<<Simulations: sub interfaces>>=
	module function entry_count_nlo_entries (entry) result (n)
	class(entry_t), intent(in), target :: entry
	integer :: n
	end function entry_count_nlo_entries
	<<Simulations: procedures>>=
	module function entry_count_nlo_entries (entry) result (n)
	class(entry_t), intent(in), target :: entry
	integer :: n
	type(entry_t), pointer :: current_entry
	n = 1
	if (.not. associated (entry%next)) then
	return
	else
	current_entry => entry%next
	do
	n = n + 1
	if (.not. associated (current_entry%next)) exit
	current_entry => current_entry%next
	end do
	end if
	end function entry_count_nlo_entries

	@ %def entry_count_nlo_entries
	@
	<<Simulations: entry: TBP>>=
	procedure :: reset_nlo_counter => entry_reset_nlo_counter
	<<Simulations: sub interfaces>>=
	module subroutine entry_reset_nlo_counter (entry)
	class(entry_t), intent(inout) :: entry
	end subroutine entry_reset_nlo_counter
	<<Simulations: procedures>>=
	module subroutine entry_reset_nlo_counter (entry)
	class(entry_t), intent(inout) :: entry
	class(evt_t), pointer :: evt
	evt => entry%transform_first
	do
	select type (evt)
	type is (evt_nlo_t)
	evt%i_evaluation = 0
	exit
	end select
	if (associated (evt%next)) evt => evt%next
	end do
	end subroutine entry_reset_nlo_counter

	@ %def entry_reset_nlo_counter
	@
	<<Simulations: entry: TBP>>=
	procedure :: determine_if_powheg_matching => &
	entry_determine_if_powheg_matching
	<<Simulations: sub interfaces>>=
	module subroutine entry_determine_if_powheg_matching (entry)
	class(entry_t), intent(inout) :: entry
	end subroutine entry_determine_if_powheg_matching
	<<Simulations: procedures>>=
	module subroutine entry_determine_if_powheg_matching (entry)
	class(entry_t), intent(inout) :: entry
	class(evt_t), pointer :: current_transform
	if (associated (entry%transform_first)) then
	current_transform => entry%transform_first
	do
	select type (current_transform)
	type is (evt_shower_t)
	if (current_transform%contains_powheg_matching ()) &
	entry%evt_powheg => current_transform
	exit
	end select
	if (associated (current_transform%next)) then
	current_transform => current_transform%next
	else
	exit
	end if
	end do
	end if
	end subroutine entry_determine_if_powheg_matching

	@ %def entry_determine_if_powheg_matching
	@
	\subsubsection{Event-transform initialization}
	Part of simulation-entry initialization: dispatch event transforms
	(decay, shower) as requested. If a transform is not applicable or
	switched off via some variable, it will be skipped.

	Regarding resonances/decays: these two transforms are currently mutually
	exclusive. Resonance insertion will not be applied if there is an
	unstable particle in the game.

	The initial particle set is the output of the trivial transform; this
	has already been applied when the transforms listed here are
	encountered. Each transform takes a particle set and produces a new
	one, with one exception: the decay module takes its input from the
	process object, ignoring the trivial transform. (Reason: spin
	correlations.) Therefore, the decay module must be first in line.

	Settings that we don't or can't support (yet) are rejected by the
	embedded call to [[event_transforms_check]].
	<<Simulations: entry: TBP>>=
	procedure, private :: setup_event_transforms &
	=> entry_setup_event_transforms
	<<Simulations: sub interfaces>>=
	module subroutine entry_setup_event_transforms (entry, process, local)
	class(entry_t), intent(inout) :: entry
	type(process_t), intent(inout), target :: process
	type(rt_data_t), intent(in), target :: local
	end subroutine entry_setup_event_transforms
	<<Simulations: procedures>>=
	module subroutine entry_setup_event_transforms (entry, process, local)
	class(entry_t), intent(inout) :: entry
	type(process_t), intent(inout), target :: process
	type(rt_data_t), intent(in), target :: local
	class(evt_t), pointer :: evt
	type(var_list_t), pointer :: var_list
	logical :: enable_isr_handler
	logical :: enable_epa_handler
	logical :: enable_fixed_order
	logical :: enable_shower
	character(len=7) :: sample_normalization

	call event_transforms_check (entry, process, local)
	var_list => local%get_var_list_ptr ()

	if (process%contains_unstable (local%model)) then
	call dispatch_evt_decay (evt, local%var_list)
	if (associated (evt)) call entry%import_transform (evt)
	end if

	if (entry%resonant_subprocess_set%is_active ()) then
	call dispatch_evt_resonance (evt, local%var_list, &
	entry%resonant_subprocess_set%get_resonance_history_set (), &
	entry%resonant_subprocess_set%get_libname ())
	if (associated (evt)) then
	call entry%resonant_subprocess_set%connect_transform (evt)
	call entry%resonant_subprocess_set%set_on_shell_limit &
	(local%get_rval (var_str ("resonance_on_shell_limit")))
	call entry%resonant_subprocess_set%set_on_shell_turnoff &
	(local%get_rval (var_str ("resonance_on_shell_turnoff")))
	call entry%resonant_subprocess_set%set_background_factor &
	(local%get_rval (var_str ("resonance_background_factor")))
	call entry%import_transform (evt)
	end if
	end if

	enable_fixed_order = local%get_lval (var_str ("?fixed_order_nlo_events"))
	if (enable_fixed_order) then
	call dispatch_evt_nlo &
	(evt, local%get_lval (var_str ("?keep_failed_events")))
	call entry%import_transform (evt)
	end if

	enable_isr_handler = local%get_lval (var_str ("?isr_handler"))
	enable_epa_handler = local%get_lval (var_str ("?epa_handler"))
	if (enable_isr_handler .or. enable_epa_handler) then
	call dispatch_evt_isr_epa_handler (evt, local%var_list)
	if (associated (evt)) call entry%import_transform (evt)
	end if

	enable_shower = local%get_lval (var_str ("?allow_shower")) .and. &
	(local%get_lval (var_str ("?ps_isr_active")) &
	.or. local%get_lval (var_str ("?ps_fsr_active")) &
	.or. local%get_lval (var_str ("?muli_active")) &
	.or. local%get_lval (var_str ("?mlm_matching")) &
	.or. local%get_lval (var_str ("?ckkw_matching")) &
	.or. local%get_lval (var_str ("?powheg_matching")))
	if (enable_shower) then
	call dispatch_evt_shower (evt, var_list, local%model, &
	local%fallback_model, local%os_data, local%beam_structure, &
	process)
	call entry%import_transform (evt)
	end if

	if (local%get_lval (var_str ("?hadronization_active"))) then
	call dispatch_evt_hadrons (evt, var_list, local%fallback_model)
	call entry%import_transform (evt)
	end if

	end subroutine entry_setup_event_transforms

	@ %def entry_setup_event_transforms
	@
	This routine rejects all event-transform settings which we don't
	support at present.
	<<Simulations: procedures>>=
	subroutine event_transforms_check (entry, process, local)
	class(entry_t), intent(in) :: entry
	type(process_t), intent(in), target :: process
	type(rt_data_t), intent(in), target :: local

	if (local%get_lval (var_str ("?fixed_order_nlo_events"))) then
	if (local%get_lval (var_str ("?unweighted"))) then
	call msg_fatal ("NLO fixed-order events have to be generated with &
	&?unweighted = false")
	end if
	select case (char (local%get_sval (var_str ("$sample_normalization"))))
	case ("sigma", "auto")
	case default
	call msg_fatal ("NLO fixed-order events: only &
	&$sample_normalization = 'sigma' is supported.")
	end select
	if (process%contains_unstable (local%model)) then
	call msg_fatal ("NLO fixed-order events: unstable final-state &
	&particles not supported yet")
	end if
	if (entry%resonant_subprocess_set%is_active ()) then
	call msg_fatal ("NLO fixed-order events: resonant subprocess &
	&insertion not supported")
	end if
	if (local%get_lval (var_str ("?isr_handler")) &
	.or. local%get_lval (var_str ("?epa_handler"))) then
	call msg_fatal ("NLO fixed-order events: ISR handler for &
	&photon-pT generation not supported yet")
	end if
	end if

	if (process%contains_unstable (local%model) &
	.and. entry%resonant_subprocess_set%is_active ()) then
	call msg_fatal ("Simulation: resonant subprocess insertion with &
	&unstable final-state particles not supported")
	end if

	end subroutine event_transforms_check

	@ %def event_transforms_check
	@
	\subsubsection{Process/MCI selector}
	Compute weights. The integral in the argument is the sum of integrals for
	all processes in the sample. After computing the process weights, we repeat
	the normalization procedure for the process components.
	<<Simulations: entry: TBP>>=
	procedure :: init_mci_selector => entry_init_mci_selector
	<<Simulations: sub interfaces>>=
	module subroutine entry_init_mci_selector (entry, negative_weights)
	class(entry_t), intent(inout), target :: entry
	logical, intent(in), optional :: negative_weights
	end subroutine entry_init_mci_selector
	<<Simulations: procedures>>=
	module subroutine entry_init_mci_selector (entry, negative_weights)
	class(entry_t), intent(inout), target :: entry
	logical, intent(in), optional :: negative_weights
	type(entry_t), pointer :: current_entry
	integer :: i, j, k
	if (debug_on) call msg_debug (D_CORE, "entry_init_mci_selector")
	if (entry%has_integral) then
	select type (entry)
	type is (entry_t)
	current_entry => entry
	do j = 1, current_entry%count_nlo_entries ()
	if (j > 1) current_entry => current_entry%get_next ()
	do k = 1, size(current_entry%mci_sets%integral)
	if (debug_on) call msg_debug &
	(D_CORE, "current_entry%mci_sets(k)%integral", &
	current_entry%mci_sets(k)%integral)
	end do
	call current_entry%mci_selector%init &
	(current_entry%mci_sets%integral, negative_weights)
	do i = 1, current_entry%n_mci
	current_entry%mci_sets(i)%weight_mci = &
	current_entry%mci_selector%get_weight (i)
	end do
	end do
	end select
	end if
	end subroutine entry_init_mci_selector

	@ %def entry_init_mci_selector
	@ Select a MCI entry, using the embedded random-number generator.
	<<Simulations: entry: TBP>>=
	procedure :: select_mci => entry_select_mci
	<<Simulations: sub interfaces>>=
	module function entry_select_mci (entry) result (i_mci)
	class(entry_t), intent(inout) :: entry
	integer :: i_mci
	end function entry_select_mci
	<<Simulations: procedures>>=
	module function entry_select_mci (entry) result (i_mci)
	class(entry_t), intent(inout) :: entry
	integer :: i_mci
	if (debug_on) call msg_debug2 (D_CORE, "entry_select_mci")
	i_mci = entry%process%extract_active_component_mci ()
	if (i_mci == 0) call entry%mci_selector%generate (entry%rng, i_mci)
	if (debug_on) call msg_debug2 (D_CORE, "i_mci", i_mci)
	end function entry_select_mci

	@ %def entry_select_mci
	@
	\subsubsection{Entries: event-wise updates}
	Record an event for this entry, i.e., increment the appropriate counters.
	<<Simulations: entry: TBP>>=
	procedure :: record => entry_record
	<<Simulations: sub interfaces>>=
	module subroutine entry_record (entry, i_mci, from_file)
	class(entry_t), intent(inout) :: entry
	integer, intent(in) :: i_mci
	logical, intent(in), optional :: from_file
	end subroutine entry_record
	<<Simulations: procedures>>=
	module subroutine entry_record (entry, i_mci, from_file)
	class(entry_t), intent(inout) :: entry
	integer, intent(in) :: i_mci
	logical, intent(in), optional :: from_file
	real(default) :: weight, excess
	integer :: n_dropped
	weight = entry%get_weight_prc ()
	excess = entry%get_excess_prc ()
	n_dropped = entry%get_n_dropped ()
	call entry%counter%record (weight, excess, n_dropped, from_file)
	if (i_mci > 0) then
	call entry%mci_sets(i_mci)%counter%record (weight, excess)
	end if
	end subroutine entry_record

	@ %def entry_record
	@ Update and restore the process core that this entry accesses, when
	parameters change. If explicit arguments [[model]], [[qcd]], or
	[[helicity_selection]] are provided, use those. Otherwise use the
	parameters stored in the process object.

	These two procedures come with a caching mechanism which guarantees
	that the current core object is saved when calling [[update_process]],
	and restored by calling [[restore_process]]. If the flag [[saved]] is
	unset, saving is skipped, and the [[restore]] procedure should not be
	called.
	<<Simulations: entry: TBP>>=
	procedure :: update_process => entry_update_process
	procedure :: restore_process => entry_restore_process
	<<Simulations: sub interfaces>>=
	module subroutine entry_update_process &
	(entry, model, qcd, helicity_selection, saved)
	class(entry_t), intent(inout) :: entry
	class(model_data_t), intent(in), optional, target :: model
	type(qcd_t), intent(in), optional :: qcd
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	logical, intent(in), optional :: saved
	end subroutine entry_update_process
	module subroutine entry_restore_process (entry)
	class(entry_t), intent(inout) :: entry
	end subroutine entry_restore_process
	<<Simulations: procedures>>=
	module subroutine entry_update_process &
	(entry, model, qcd, helicity_selection, saved)
	class(entry_t), intent(inout) :: entry
	class(model_data_t), intent(in), optional, target :: model
	type(qcd_t), intent(in), optional :: qcd
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	logical, intent(in), optional :: saved
	type(process_t), pointer :: process
	class(prc_core_t), allocatable :: core
	integer :: i, n_terms
	class(model_data_t), pointer :: model_local
	type(qcd_t) :: qcd_local
	logical :: use_saved
	if (present (model)) then
	model_local => model
	else
	model_local => entry%model
	end if
	if (present (qcd)) then
	qcd_local = qcd
	else
	qcd_local = entry%qcd
	end if
	use_saved = .true.; if (present (saved)) use_saved = saved
	process => entry%get_process_ptr ()
	n_terms = process%get_n_terms ()
	if (use_saved) allocate (entry%core_safe (n_terms))
	do i = 1, n_terms
	if (process%has_matrix_element (i, is_term_index = .true.)) then
	call process%extract_core (i, core)
	if (use_saved) then
	call dispatch_core_update (core, &
	model_local, helicity_selection, qcd_local, &
	entry%core_safe(i)%core)
	else
	call dispatch_core_update (core, &
	model_local, helicity_selection, qcd_local)
	end if
	call process%restore_core (i, core)
	end if
	end do
	end subroutine entry_update_process

	module subroutine entry_restore_process (entry)
	class(entry_t), intent(inout) :: entry
	type(process_t), pointer :: process
	class(prc_core_t), allocatable :: core
	integer :: i, n_terms
	process => entry%get_process_ptr ()
	n_terms = process%get_n_terms ()
	do i = 1, n_terms
	if (process%has_matrix_element (i, is_term_index = .true.)) then
	call process%extract_core (i, core)
	call dispatch_core_restore (core, entry%core_safe(i)%core)
	call process%restore_core (i, core)
	end if
	end do
	deallocate (entry%core_safe)
	end subroutine entry_restore_process

	@ %def entry_update_process
	@ %def entry_restore_process
	<<Simulations: entry: TBP>>=
	procedure :: connect_qcd => entry_connect_qcd
	<<Simulations: sub interfaces>>=
	module subroutine entry_connect_qcd (entry)
	class(entry_t), intent(inout), target :: entry
	end subroutine entry_connect_qcd
	<<Simulations: procedures>>=
	module subroutine entry_connect_qcd (entry)
	class(entry_t), intent(inout), target :: entry
	class(evt_t), pointer :: evt
	evt => entry%transform_first
	do while (associated (evt))
	select type (evt)
	type is (evt_shower_t)
	evt%qcd = entry%qcd
	if (allocated (evt%matching)) then
	evt%matching%qcd = entry%qcd
	end if
	end select
	evt => evt%next
	end do
	end subroutine entry_connect_qcd

	@ %def entry_connect_qcd
	@
	\subsection{Handling resonant subprocesses}
	Resonant subprocesses are required if we want to determine resonance histories
	when generating events. The feature is optional, to be switched on by
	the user.

	This procedure initializes a new, separate process library that
	contains copies of the current process, restricted to the relevant
	resonance histories. (If this library exists already, it is just
	kept.) The histories can be extracted from the process object.

	The code has to match the assignments in
	[[create_resonant_subprocess_library]]. The library may already
	exist -- in that case, here it will be recovered without recompilation.
	<<Simulations: entry: TBP>>=
	procedure :: setup_resonant_subprocesses &
	=> entry_setup_resonant_subprocesses
	<<Simulations: sub interfaces>>=
	module subroutine entry_setup_resonant_subprocesses (entry, global, process)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(inout), target :: global
	type(process_t), intent(in), target :: process
	end subroutine entry_setup_resonant_subprocesses
	<<Simulations: procedures>>=
	module subroutine entry_setup_resonant_subprocesses (entry, global, process)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(inout), target :: global
	type(process_t), intent(in), target :: process
	type(string_t) :: libname
	type(resonance_history_set_t) :: res_history_set
	type(process_library_t), pointer :: lib
	type(process_component_def_t), pointer :: process_component_def
	logical :: req_resonant, library_exist
	integer :: i_component
	libname = process%get_library_name ()
	lib => global%prclib_stack%get_library_ptr (libname)
	entry%has_resonant_subprocess_set = lib%req_resonant (process%get_id ())
	if (entry%has_resonant_subprocess_set) then
	libname = get_libname_res (process%get_id ())
	call entry%resonant_subprocess_set%init (process%get_n_components ())
	call entry%resonant_subprocess_set%create_library &
	(libname, global, library_exist)
	do i_component = 1, process%get_n_components ()
	select case (process%get_component_type (i_component))
	case (COMP_MASTER, COMP_REAL_FIN, COMP_REAL_SING, COMP_REAL)
	call process%extract_resonance_history_set &
	(res_history_set, i_component = i_component)
	call entry%resonant_subprocess_set%fill_resonances &
	(res_history_set, i_component)
	if (.not. library_exist) then
	process_component_def &
	=> process%get_component_def_ptr (i_component)
	call entry%resonant_subprocess_set%add_to_library &
	(i_component, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end if
	end select
	end do
	call entry%resonant_subprocess_set%freeze_library (global)
	end if
	end subroutine entry_setup_resonant_subprocesses

	@ %def entry_setup_resonant_subprocesses
	@ Compile the resonant-subprocesses library. The library is assumed
	to be the current library in the [[global]] object. This is a simple wrapper.
	<<Simulations: entry: TBP>>=
	procedure :: compile_resonant_subprocesses &
	=> entry_compile_resonant_subprocesses
	<<Simulations: sub interfaces>>=
	module subroutine entry_compile_resonant_subprocesses (entry, global)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(inout), target :: global
	end subroutine entry_compile_resonant_subprocesses
	<<Simulations: procedures>>=
	module subroutine entry_compile_resonant_subprocesses (entry, global)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(inout), target :: global
	call entry%resonant_subprocess_set%compile_library (global)
	end subroutine entry_compile_resonant_subprocesses

	@ %def entry_compile_resonant_subprocesses
	@ Prepare process objects for the resonant-subprocesses library. The
	process objects are appended to the global process stack. We
	initialize the processes, such that we can evaluate matrix elements,
	but we do not need to integrate them.
	<<Simulations: entry: TBP>>=
	procedure :: prepare_resonant_subprocesses &
	=> entry_prepare_resonant_subprocesses
	<<Simulations: sub interfaces>>=
	module subroutine entry_prepare_resonant_subprocesses (entry, local, global)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	end subroutine entry_prepare_resonant_subprocesses
	<<Simulations: procedures>>=
	module subroutine entry_prepare_resonant_subprocesses (entry, local, global)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	call entry%resonant_subprocess_set%prepare_process_objects (local, global)
	end subroutine entry_prepare_resonant_subprocesses

	@ %def entry_prepare_resonant_subprocesses
	@ Prepare process instances. They are linked to their corresponding process
	objects. Both, process and instance objects, are allocated as anonymous
	targets inside the [[resonant_subprocess_set]] component.

	NOTE: those anonymous object are likely forgotten during finalization of the
	parent [[event_t]] (extended as [[entry_t]]) object. This should be checked!
	The memory leak is probably harmless as long as the event object is created
	once per run, not once per event.
	<<Simulations: entry: TBP>>=
	procedure :: prepare_resonant_subprocess_instances &
	=> entry_prepare_resonant_subprocess_instances
	<<Simulations: sub interfaces>>=
	module subroutine entry_prepare_resonant_subprocess_instances &
	(entry, global)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(in), target :: global
	end subroutine entry_prepare_resonant_subprocess_instances
	<<Simulations: procedures>>=
	module subroutine entry_prepare_resonant_subprocess_instances (entry, global)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(in), target :: global
	call entry%resonant_subprocess_set%prepare_process_instances (global)
	end subroutine entry_prepare_resonant_subprocess_instances

	@ %def entry_prepare_resonant_subprocess_instances
	@ Display the resonant subprocesses. This includes, upon request, the
	resonance set that defines those subprocess, and a short or long account of the
	process objects themselves.
	<<Simulations: entry: TBP>>=
	procedure :: write_resonant_subprocess_data &
	=> entry_write_resonant_subprocess_data
	<<Simulations: sub interfaces>>=
	module subroutine entry_write_resonant_subprocess_data (entry, unit)
	class(entry_t), intent(in) :: entry
	integer, intent(in), optional :: unit
	end subroutine entry_write_resonant_subprocess_data
	<<Simulations: procedures>>=
	module subroutine entry_write_resonant_subprocess_data (entry, unit)
	class(entry_t), intent(in) :: entry
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	call entry%resonant_subprocess_set%write (unit)
	write (u, "(1x,A,I0)") "Resonant subprocesses refer to &
	&process component #", 1
	end subroutine entry_write_resonant_subprocess_data

	@ %def entry_write_resonant_subprocess_data
	@ Display of the master process for the current event, for diagnostics.
	<<Simulations: entry: TBP>>=
	procedure :: write_process_data => entry_write_process_data
	<<Simulations: sub interfaces>>=
	module subroutine entry_write_process_data &
	(entry, unit, show_process, show_instance, verbose)
	class(entry_t), intent(in) :: entry
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_process
	logical, intent(in), optional :: show_instance
	logical, intent(in), optional :: verbose
	end subroutine entry_write_process_data
	<<Simulations: procedures>>=
	module subroutine entry_write_process_data &
	(entry, unit, show_process, show_instance, verbose)
	class(entry_t), intent(in) :: entry
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_process
	logical, intent(in), optional :: show_instance
	logical, intent(in), optional :: verbose
	integer :: u, i
	logical :: s_proc, s_inst, verb
	type(process_t), pointer :: process
	type(process_instance_t), pointer :: instance
	u = given_output_unit (unit)
	s_proc = .false.; if (present (show_process)) s_proc = show_process
	s_inst = .false.; if (present (show_instance)) s_inst = show_instance
	verb = .false.; if (present (verbose)) verb = verbose
	if (s_proc .or. s_inst) then
	write (u, "(1x,A,':')") "Process data"
	if (s_proc) then
	process => entry%process
	if (associated (process)) then
	if (verb) then
	call write_separator (u, 2)
	call process%write (.false., u)
	else
	call process%show (u, verbose=.false.)
	end if
	else
	write (u, "(3x,A)") "[not associated]"
	end if
	end if
	if (s_inst) then
	instance => entry%instance
	if (associated (instance)) then
	if (verb) then
	call instance%write (u)
	else
	call instance%write_header (u)
	end if
	else
	write (u, "(3x,A)") "Process instance: [not associated]"
	end if
	end if
	end if
	end subroutine entry_write_process_data

	@ %def entry_write_process_data
	@
	\subsection{Entries for alternative environment}
	Entries for alternate environments. [No additional components
	anymore, so somewhat redundant.]
	<<Simulations: types>>=
	type, extends (entry_t) :: alt_entry_t
	contains
	<<Simulations: alt entry: TBP>>
	end type alt_entry_t

	@ %def alt_entry_t
	@ The alternative entries are there to re-evaluate the event, given
	momenta, in a different context.

	Therefore, we allocate a local process object and use this as the
	reference for the local process instance, when initializing the entry.
	We temporarily import the [[process]] object into an [[integration_t]]
	wrapper, to take advantage of the associated methods. The local
	process object is built in the context of the current environment,
	here called [[global]]. Then, we initialize the process instance.

	The [[master_process]] object contains the integration results to which we
	refer when recalculating an event. Therefore, we use this object instead of
	the locally built [[process]] when we extract the integration results.

	The locally built [[process]] object should be finalized when done. It
	remains accessible via the [[event_t]] base object of [[entry]], which
	contains pointers to the process and instance.
	<<Simulations: alt entry: TBP>>=
	procedure :: init_alt => alt_entry_init
	<<Simulations: sub interfaces>>=
	module subroutine alt_entry_init (entry, process_id, master_process, local)
	class(alt_entry_t), intent(inout), target :: entry
	type(string_t), intent(in) :: process_id
	type(process_t), intent(in), target :: master_process
	type(rt_data_t), intent(inout), target :: local
	end subroutine alt_entry_init
	<<Simulations: procedures>>=
	module subroutine alt_entry_init (entry, process_id, master_process, local)
	class(alt_entry_t), intent(inout), target :: entry
	type(string_t), intent(in) :: process_id
	type(process_t), intent(in), target :: master_process
	type(rt_data_t), intent(inout), target :: local
	type(process_t), pointer :: process
	type(process_instance_t), pointer :: process_instance
	type(string_t) :: run_id
	integer :: i

	call msg_message ("Simulate: initializing alternate process setup ...")

	run_id = &
	local%var_list%get_sval (var_str ("$run_id"))
	call local%set_log (var_str ("?rebuild_phase_space"), &
	.false., is_known = .true.)
	call local%set_log (var_str ("?check_phs_file"), &
	.false., is_known = .true.)
	call local%set_log (var_str ("?rebuild_grids"), &
	.false., is_known = .true.)

	call entry%basic_init (local%var_list)

	call prepare_local_process (process, process_id, local)
	entry%process_id = process_id
	entry%run_id = run_id

	call entry%import_process_characteristics (process)

	allocate (entry%mci_sets (entry%n_mci))
	do i = 1, size (entry%mci_sets)
	call entry%mci_sets(i)%init (i, master_process)
	end do

	call entry%import_process_results (master_process)
	call entry%prepare_expressions (local)

	call prepare_process_instance (process_instance, process, local%model)
	call entry%setup_event_transforms (process, local)

	call entry%connect (process_instance, local%model, local%process_stack)
	call entry%setup_expressions ()

	entry%model => process%get_model_ptr ()

	call msg_message ("... alternate process setup complete.")

	end subroutine alt_entry_init

	@ %def alt_entry_init
	@ Copy the particle set from the master entry to the alternate entry.
	This is the particle set of the hard process.
	<<Simulations: alt entry: TBP>>=
	procedure :: fill_particle_set => entry_fill_particle_set
	<<Simulations: sub interfaces>>=
	module subroutine entry_fill_particle_set (alt_entry, entry)
	class(alt_entry_t), intent(inout) :: alt_entry
	class(entry_t), intent(in), target :: entry
	end subroutine entry_fill_particle_set
	<<Simulations: procedures>>=
	module subroutine entry_fill_particle_set (alt_entry, entry)
	class(alt_entry_t), intent(inout) :: alt_entry
	class(entry_t), intent(in), target :: entry
	type(particle_set_t) :: pset
	call entry%get_hard_particle_set (pset)
	call alt_entry%set_hard_particle_set (pset)
	call pset%final ()
	end subroutine entry_fill_particle_set

	@ %def particle_set_copy_prt
	@
	\subsection{The simulation object}
	Each simulation object corresponds to an event sample, identified by
	the [[sample_id]].

	The simulation may cover several processes simultaneously. All
	process-specific data, including the event records, are stored in the
	[[entry]] subobjects. The [[current]] index indicates which record
	was selected last. [[version]] is foreseen to contain a tag on the \whizard\
	event file version. It can be
	<<Simulations: public>>=
	public :: simulation_t
	<<Simulations: types>>=
	type :: simulation_t
	private
	type(rt_data_t), pointer :: local => null ()
	type(string_t) :: sample_id
	logical :: unweighted = .true.
	logical :: negative_weights = .false.
	logical :: support_resonance_history = .false.
	logical :: respect_selection = .true.
	integer :: norm_mode = NORM_UNDEFINED
	logical :: update_sqme = .false.
	logical :: update_weight = .false.
	logical :: update_event = .false.
	logical :: recover_beams = .false.
	logical :: pacify = .false.
	integer :: n_max_tries = 10000
	integer :: n_prc = 0
	integer :: n_alt = 0
	logical :: has_integral = .false.
	logical :: valid = .false.
	real(default) :: integral = 0
	real(default) :: error = 0
	integer :: version = 1
	character(32) :: md5sum_prc = ""
	character(32) :: md5sum_cfg = ""
	character(32), dimension(:), allocatable :: md5sum_alt
	type(entry_t), dimension(:), allocatable :: entry
	type(alt_entry_t), dimension(:,:), allocatable :: alt_entry
	type(selector_t) :: process_selector
	integer :: n_evt_requested = 0
	integer :: event_index_offset = 0
	logical :: event_index_set = .false.
	integer :: event_index = 0
	integer :: split_n_evt = 0
	integer :: split_n_kbytes = 0
	integer :: split_index = 0
	type(counter_t) :: counter
	class(rng_t), allocatable :: rng
	integer :: i_prc = 0
	integer :: i_mci = 0
	real(default) :: weight = 0
	real(default) :: excess = 0
	integer :: n_dropped = 0
	contains
	<<Simulations: simulation: TBP>>
	end type simulation_t

	@ %def simulation_t
	@
	\subsubsection{Output of the simulation data}
	[[write_config]] writes just the configuration. [[write]]
	as a method of the base type [[event_t]]
	writes the current event and process instance, depending on options.
	<<Simulations: simulation: TBP>>=
	procedure :: write => simulation_write
	<<Simulations: sub interfaces>>=
	module subroutine simulation_write (object, unit, testflag)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine simulation_write
	<<Simulations: procedures>>=
	module subroutine simulation_write (object, unit, testflag)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	logical :: pacified
	integer :: u, i
	u = given_output_unit (unit)
	pacified = object%pacify; if (present (testflag)) pacified = testflag
	call write_separator (u, 2)
	write (u, "(1x,A,A,A)") "Event sample: '", char (object%sample_id), "'"
	write (u, "(3x,A,I0)") "Processes = ", object%n_prc
	if (object%n_alt > 0) then
	write (u, "(3x,A,I0)") "Alt.wgts = ", object%n_alt
	end if
	write (u, "(3x,A,L1)") "Unweighted = ", object%unweighted
	write (u, "(3x,A,A)") "Event norm = ", &
	char (event_normalization_string (object%norm_mode))
	write (u, "(3x,A,L1)") "Neg. weights = ", object%negative_weights
	write (u, "(3x,A,L1)") "Res. history = ", object%support_resonance_history
	write (u, "(3x,A,L1)") "Respect sel. = ", object%respect_selection
	write (u, "(3x,A,L1)") "Update sqme = ", object%update_sqme
	write (u, "(3x,A,L1)") "Update wgt = ", object%update_weight
	write (u, "(3x,A,L1)") "Update event = ", object%update_event
	write (u, "(3x,A,L1)") "Recov. beams = ", object%recover_beams
	write (u, "(3x,A,L1)") "Pacify = ", object%pacify
	write (u, "(3x,A,I0)") "Max. tries = ", object%n_max_tries
	if (object%has_integral) then
	if (pacified) then
	write (u, "(3x,A," // FMT_15 // ")") &
	"Integral = ", object%integral
	write (u, "(3x,A," // FMT_15 // ")") &
	"Error = ", object%error
	else
	write (u, "(3x,A," // FMT_19 // ")") &
	"Integral = ", object%integral
	write (u, "(3x,A," // FMT_19 // ")") &
	"Error = ", object%error
	end if
	else
	write (u, "(3x,A)") "Integral = [undefined]"
	end if
	write (u, "(3x,A,L1)") "Sim. valid = ", object%valid
	write (u, "(3x,A,I0)") "Ev.file ver. = ", object%version
	if (object%md5sum_prc /= "") then
	write (u, "(3x,A,A,A)") "MD5 sum (proc) = '", object%md5sum_prc, "'"
	end if
	if (object%md5sum_cfg /= "") then
	write (u, "(3x,A,A,A)") "MD5 sum (config) = '", object%md5sum_cfg, "'"
	end if
	write (u, "(3x,A,I0)") "Events requested = ", object%n_evt_requested
	if (object%event_index_offset /= 0) then
	write (u, "(3x,A,I0)") "Event index offset= ", object%event_index_offset
	end if
	if (object%event_index_set) then
	write (u, "(3x,A,I0)") "Event index = ", object%event_index
	end if
	if (object%split_n_evt > 0 .or. object%split_n_kbytes > 0) then
	write (u, "(3x,A,I0)") "Events per file = ", object%split_n_evt
	write (u, "(3x,A,I0)") "KBytes per file = ", object%split_n_kbytes
	write (u, "(3x,A,I0)") "First file index = ", object%split_index
	end if
	call object%counter%write (u)
	call write_separator (u)
	if (object%i_prc /= 0) then
	write (u, "(1x,A)") "Current event:"
	write (u, "(3x,A,I0,A,A)") "Process #", &
	object%i_prc, ": ", &
	char (object%entry(object%i_prc)%process_id)
	write (u, "(3x,A,I0)") "MCI set #", object%i_mci
	write (u, "(3x,A," // FMT_19 // ")") "Weight = ", object%weight
	if (.not. vanishes (object%excess)) &
	write (u, "(3x,A," // FMT_19 // ")") "Excess = ", object%excess
	write (u, "(3x,A,I0)") "Zero-weight events dropped = ", object%n_dropped
	else
	write (u, "(1x,A,I0,A,A)") "Current event: [undefined]"
	end if
	call write_separator (u)
	if (allocated (object%rng)) then
	call object%rng%write (u)
	else
	write (u, "(3x,A)") "Random-number generator: [undefined]"
	end if
	if (allocated (object%entry)) then
	do i = 1, size (object%entry)
	if (i == 1) then
	call write_separator (u, 2)
	else
	call write_separator (u)
	end if
	write (u, "(1x,A,I0,A)") "Process #", i, ":"
	call object%entry(i)%write_config (u, pacified)
	end do
	end if
	call write_separator (u, 2)
	end subroutine simulation_write

	@ %def simulation_write
	@ Write the current event record. If an explicit index is given,
	write that event record.

	We implement writing to [[unit]] (event contents / debugging format)
	and writing to an [[eio]] event stream (storage). We include a [[testflag]]
	in order to suppress numerical noise in the testsuite.
	<<Simulations: simulation: TBP>>=
	generic :: write_event => write_event_unit
	procedure :: write_event_unit => simulation_write_event_unit
	<<Simulations: sub interfaces>>=
	module subroutine simulation_write_event_unit &
	(object, unit, i_prc, verbose, testflag)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer, intent(in), optional :: i_prc
	logical, intent(in), optional :: testflag
	end subroutine simulation_write_event_unit
	<<Simulations: procedures>>=
	module subroutine simulation_write_event_unit &
	(object, unit, i_prc, verbose, testflag)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer, intent(in), optional :: i_prc
	logical, intent(in), optional :: testflag
	logical :: pacified
	integer :: current
	pacified = .false.; if (present(testflag)) pacified = testflag
	pacified = pacified .or. object%pacify
	if (present (i_prc)) then
	current = i_prc
	else
	current = object%i_prc
	end if
	if (current > 0) then
	call object%entry(current)%write (unit, verbose = verbose, &
	testflag = pacified)
	else
	call msg_fatal ("Simulation: write event: no process selected")
	end if
	end subroutine simulation_write_event_unit

	@ %def simulation_write_event
	@ This writes one of the alternate events, if allocated.
	<<Simulations: simulation: TBP>>=
	procedure :: write_alt_event => simulation_write_alt_event
	<<Simulations: sub interfaces>>=
	module subroutine simulation_write_alt_event (object, unit, j_alt, i_prc, &
	verbose, testflag)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: j_alt
	integer, intent(in), optional :: i_prc
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: testflag
	end subroutine simulation_write_alt_event
	<<Simulations: procedures>>=
	module subroutine simulation_write_alt_event (object, unit, j_alt, i_prc, &
	verbose, testflag)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: j_alt
	integer, intent(in), optional :: i_prc
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: testflag
	integer :: i, j
	if (present (j_alt)) then
	j = j_alt
	else
	j = 1
	end if
	if (present (i_prc)) then
	i = i_prc
	else
	i = object%i_prc
	end if
	if (i > 0) then
	if (j> 0 .and. j <= object%n_alt) then
	call object%alt_entry(i,j)%write (unit, verbose = verbose, &
	testflag = testflag)
	else
	call msg_fatal ("Simulation: write alternate event: out of range")
	end if
	else
	call msg_fatal ("Simulation: write alternate event: no process selected")
	end if
	end subroutine simulation_write_alt_event

	@ %def simulation_write_alt_event
	@ This writes the contents of the resonant subprocess set in the current event
	record.
	<<Simulations: simulation: TBP>>=
	procedure :: write_resonant_subprocess_data &
	=> simulation_write_resonant_subprocess_data
	<<Simulations: sub interfaces>>=
	module subroutine simulation_write_resonant_subprocess_data &
	(object, unit, i_prc)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: i_prc
	end subroutine simulation_write_resonant_subprocess_data
	<<Simulations: procedures>>=
	module subroutine simulation_write_resonant_subprocess_data &
	(object, unit, i_prc)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: i_prc
	integer :: i
	if (present (i_prc)) then
	i = i_prc
	else
	i = object%i_prc
	end if
	call object%entry(i)%write_resonant_subprocess_data (unit)
	end subroutine simulation_write_resonant_subprocess_data

	@ %def simulation_write_resonant_subprocess_data
	@ The same for the master process, as an additional debugging aid.
	<<Simulations: simulation: TBP>>=
	procedure :: write_process_data &
	=> simulation_write_process_data
	<<Simulations: sub interfaces>>=
	module subroutine simulation_write_process_data &
	(object, unit, i_prc, &
	show_process, show_instance, verbose)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: i_prc
	logical, intent(in), optional :: show_process
	logical, intent(in), optional :: show_instance
	logical, intent(in), optional :: verbose
	end subroutine simulation_write_process_data
	<<Simulations: procedures>>=
	module subroutine simulation_write_process_data &
	(object, unit, i_prc, &
	show_process, show_instance, verbose)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: i_prc
	logical, intent(in), optional :: show_process
	logical, intent(in), optional :: show_instance
	logical, intent(in), optional :: verbose
	integer :: i
	if (present (i_prc)) then
	i = i_prc
	else
	i = object%i_prc
	end if
	call object%entry(i)%write_process_data &
	(unit, show_process, show_instance, verbose)
	end subroutine simulation_write_process_data

	@ %def simulation_write_process_data
	@ Write the actual efficiency of the simulation run. We get the total
	number of events stored in the simulation counter and compare this
	with the total number of calls stored in the event entries.

	In order not to miscount samples that are partly read from file, use
	the [[generated]] counter, not the [[total]] counter.
	<<Simulations: simulation: TBP>>=
	procedure :: show_efficiency => simulation_show_efficiency
	<<Simulations: sub interfaces>>=
	module subroutine simulation_show_efficiency (simulation)
	class(simulation_t), intent(inout) :: simulation
	end subroutine simulation_show_efficiency
	<<Simulations: procedures>>=
	module subroutine simulation_show_efficiency (simulation)
	class(simulation_t), intent(inout) :: simulation
	integer :: n_events, n_calls
	real(default) :: eff
	n_events = simulation%counter%generated
	n_calls = sum (simulation%entry%get_actual_calls_total ())
	if (n_calls > 0) then
	eff = real (n_events, kind=default) / n_calls
	write (msg_buffer, "(A,1x,F6.2,1x,A)") &
	"Events: actual unweighting efficiency =", 100 * eff, "%"
	call msg_message ()
	end if
	end subroutine simulation_show_efficiency

	@ %def simulation_show_efficiency
	@ Compute the checksum of the process set. We retrieve the MD5 sums
	of all processes. This depends only on the process definitions, while
	parameters are not considered. The configuration checksum is
	retrieved from the MCI records in the process objects and furthermore
	includes beams, parameters, integration results, etc., so matching the
	latter should guarantee identical physics.
	<<Simulations: simulation: TBP>>=
	procedure :: compute_md5sum => simulation_compute_md5sum
	<<Simulations: sub interfaces>>=
	module subroutine simulation_compute_md5sum (simulation)
	class(simulation_t), intent(inout) :: simulation
	end subroutine simulation_compute_md5sum
	<<Simulations: procedures>>=
	module subroutine simulation_compute_md5sum (simulation)
	class(simulation_t), intent(inout) :: simulation
	type(process_t), pointer :: process
	type(string_t) :: buffer
	integer :: j, i, n_mci, i_mci, n_component, i_component
	if (simulation%md5sum_prc == "") then
	buffer = ""
	do i = 1, simulation%n_prc
	if (.not. simulation%entry(i)%valid) cycle
	process => simulation%entry(i)%get_process_ptr ()
	if (associated (process)) then
	n_component = process%get_n_components ()
	do i_component = 1, n_component
	if (process%has_matrix_element (i_component)) then
	buffer = buffer // process%get_md5sum_prc (i_component)
	end if
	end do
	end if
	end do
	simulation%md5sum_prc = md5sum (char (buffer))
	end if
	if (simulation%md5sum_cfg == "") then
	buffer = ""
	do i = 1, simulation%n_prc
	if (.not. simulation%entry(i)%valid) cycle
	process => simulation%entry(i)%get_process_ptr ()
	if (associated (process)) then
	n_mci = process%get_n_mci ()
	do i_mci = 1, n_mci
	buffer = buffer // process%get_md5sum_mci (i_mci)
	end do
	end if
	end do
	simulation%md5sum_cfg = md5sum (char (buffer))
	end if
	do j = 1, simulation%n_alt
	if (simulation%md5sum_alt(j) == "") then
	buffer = ""
	do i = 1, simulation%n_prc
	process => simulation%alt_entry(i,j)%get_process_ptr ()
	if (associated (process)) then
	buffer = buffer // process%get_md5sum_cfg ()
	end if
	end do
	simulation%md5sum_alt(j) = md5sum (char (buffer))
	end if
	end do
	end subroutine simulation_compute_md5sum

	@ %def simulation_compute_md5sum
	@
	\subsubsection{Simulation-object finalizer}
	<<Simulations: simulation: TBP>>=
	procedure :: final => simulation_final
	<<Simulations: sub interfaces>>=
	module subroutine simulation_final (object)
	class(simulation_t), intent(inout) :: object
	end subroutine simulation_final
	<<Simulations: procedures>>=
	module subroutine simulation_final (object)
	class(simulation_t), intent(inout) :: object
	integer :: i, j
	if (allocated (object%entry)) then
	do i = 1, size (object%entry)
	call object%entry(i)%final ()
	end do
	end if
	if (allocated (object%alt_entry)) then
	do j = 1, size (object%alt_entry, 2)
	do i = 1, size (object%alt_entry, 1)
	call object%alt_entry(i,j)%final ()
	end do
	end do
	end if
	if (allocated (object%rng)) call object%rng%final ()
	end subroutine simulation_final

	@ %def simulation_final
	@
	\subsubsection{Simulation-object initialization}
	We can deduce all data from the given list of
	process IDs and the global data set. The process objects are taken
	from the stack. Once the individual integrals are known, we add them (and the
	errors), to get the sample integral.

	If there are alternative environments, we suspend initialization for
	setting up alternative process objects, then restore the master
	process and its parameters. The generator or rescanner can then
	switch rapidly between processes.

	If [[integrate]] is set, we make sure that all affected processes are
	integrated before simulation. This is necessary if we want to actually
	generate events. If [[integrate]] is unset, we do not need the integral
	because we just rescan existing events. In that case, we just need compiled
	matrix elements.

	If [[generate]] is set, we prepare for actually generating events. Otherwise,
	we may only read and rescan events.
	<<Simulations: simulation: TBP>>=
	procedure :: init => simulation_init
	<<Simulations: sub interfaces>>=
	module subroutine simulation_init (simulation, &
	process_id, integrate, generate, local, global, alt_env)
	class(simulation_t), intent(out), target :: simulation
	type(string_t), dimension(:), intent(in) :: process_id
	logical, intent(in) :: integrate, generate
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	type(rt_data_t), dimension(:), intent(inout), optional, target :: alt_env
	end subroutine simulation_init
	<<Simulations: procedures>>=
	module subroutine simulation_init (simulation, &
	process_id, integrate, generate, local, global, alt_env)
	class(simulation_t), intent(out), target :: simulation
	type(string_t), dimension(:), intent(in) :: process_id
	logical, intent(in) :: integrate, generate
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	type(rt_data_t), dimension(:), intent(inout), optional, target :: alt_env
	class(rng_factory_t), allocatable :: rng_factory
	integer :: next_rng_seed
	type(string_t) :: norm_string, version_string
	logical :: use_process
	integer :: i, j
	type(string_t) :: sample_suffix
	<<Simulations: simulation init: extra variables>>
	sample_suffix = ""
	<<Simulations: simulation init: extra init>>
	simulation%local => local
	simulation%sample_id = &
	local%get_sval (var_str ("$sample"))
	simulation%unweighted = &
	local%get_lval (var_str ("?unweighted"))
	simulation%negative_weights = &
	local%get_lval (var_str ("?negative_weights"))
	simulation%support_resonance_history = &
	local%get_lval (var_str ("?resonance_history"))
	simulation%respect_selection = &
	local%get_lval (var_str ("?sample_select"))
	version_string = &
	local%get_sval (var_str ("$event_file_version"))
	norm_string = &
	local%get_sval (var_str ("$sample_normalization"))
	simulation%norm_mode = &
	event_normalization_mode (norm_string, simulation%unweighted)
	simulation%pacify = &
	local%get_lval (var_str ("?sample_pacify"))
	simulation%event_index_offset = &
	local%get_ival (var_str ("event_index_offset"))
	simulation%n_max_tries = &
	local%get_ival (var_str ("sample_max_tries"))
	simulation%split_n_evt = &
	local%get_ival (var_str ("sample_split_n_evt"))
	simulation%split_n_kbytes = &
	local%get_ival (var_str ("sample_split_n_kbytes"))
	simulation%split_index = &
	local%get_ival (var_str ("sample_split_index"))
	simulation%update_sqme = &
	local%get_lval (var_str ("?update_sqme"))
	simulation%update_weight = &
	local%get_lval (var_str ("?update_weight"))
	simulation%update_event = &
	local%get_lval (var_str ("?update_event"))
	simulation%recover_beams = &
	local%get_lval (var_str ("?recover_beams"))
	simulation%counter%reproduce_xsection = &
	local%get_lval (var_str ("?check_event_weights_against_xsection"))
	use_process = &
	integrate .or. generate &
	.or. simulation%update_sqme &
	.or. simulation%update_weight &
	.or. simulation%update_event &
	.or. present (alt_env)
	select case (size (process_id))
	case (0)
	call msg_error ("Simulation: no process selected")
	case (1)
	write (msg_buffer, "(A,A,A)") &
	"Starting simulation for process '", &
	char (process_id(1)), "'"
	call msg_message ()
	case default
	write (msg_buffer, "(A,A,A)") &
	"Starting simulation for processes '", &
	char (process_id(1)), "' etc."
	call msg_message ()
	end select
	select case (char (version_string))
	case ("", "2.2.4")
	simulation%version = 2
	case ("2.2")
	simulation%version = 1
	case default
	simulation%version = 0
	end select
	if (simulation%version == 0) then
	call msg_fatal ("Event file format '" &
	// char (version_string) &
	// "' is not compatible with this version.")
	end if
	simulation%n_prc = size (process_id)
	allocate (simulation%entry (simulation%n_prc))
	if (present (alt_env)) then
	simulation%n_alt = size (alt_env)
	do i = 1, simulation%n_prc
	call simulation%entry(i)%init (process_id(i), &
	use_process, integrate, generate, &
	simulation%update_sqme, &
	simulation%support_resonance_history, &
	local, global, simulation%n_alt)
	if (signal_is_pending ()) return
	end do
	simulation%valid = any (simulation%entry%valid)
	if (.not. simulation%valid) then
	call msg_error ("Simulate: no process has a valid matrix element.")
	return
	end if
	call simulation%update_processes ()
	allocate (simulation%alt_entry (simulation%n_prc, simulation%n_alt))
	allocate (simulation%md5sum_alt (simulation%n_alt))
	simulation%md5sum_alt = ""
	do j = 1, simulation%n_alt
	do i = 1, simulation%n_prc
	call simulation%alt_entry(i,j)%init_alt (process_id(i), &
	simulation%entry(i)%get_process_ptr (), alt_env(j))
	if (signal_is_pending ()) return
	end do
	end do
	call simulation%restore_processes ()
	else
	do i = 1, simulation%n_prc
	call simulation%entry(i)%init &
	(process_id(i), &
	use_process, integrate, generate, &
	simulation%update_sqme, &
	simulation%support_resonance_history, &
	local, global)
	call simulation%entry(i)%determine_if_powheg_matching ()
	if (signal_is_pending ()) return
	if (simulation%entry(i)%is_nlo ()) &
	call simulation%entry(i)%setup_additional_entries ()
	end do
	simulation%valid = any (simulation%entry%valid)
	if (.not. simulation%valid) then
	call msg_error ("Simulate: " &
	// "no process has a valid matrix element.")
	return
	end if
	end if
	!!! if this becomes conditional, some ref files will need update (seed change)
	! if (generate) then
	call dispatch_rng_factory (rng_factory, local%var_list, next_rng_seed)
	call update_rng_seed_in_var_list (local%var_list, next_rng_seed)
	call rng_factory%make (simulation%rng)
	<<Simulations: simulation init: extra RNG init>>
	! end if
	if (all (simulation%entry%has_integral)) then
	simulation%integral = sum (simulation%entry%integral)
	simulation%error = sqrt (sum (simulation%entry%error ** 2))
	simulation%has_integral = .true.
	if (integrate .and. generate) then
	do i = 1, simulation%n_prc
	if (simulation%entry(i)%integral < 0 .and. .not. &
	simulation%negative_weights) then
	call msg_fatal ("Integral of process '" // &
	char (process_id (i)) // "'is negative.")
	end if
	end do
	end if
	else
	if (integrate .and. generate) &
	call msg_error ("Simulation contains undefined integrals.")
	end if
	if (simulation%integral > 0 .or. &
	(simulation%integral < 0 .and. simulation%negative_weights)) then
	simulation%valid = .true.
	else if (generate) then
	call msg_error ("Simulate: " &
	// "sum of process integrals must be positive; skipping.")
	simulation%valid = .false.
	else
	simulation%valid = .true.
	end if
	if (simulation%sample_id == "") then
	simulation%sample_id = simulation%get_default_sample_name ()
	end if
	simulation%sample_id = simulation%sample_id // sample_suffix
	if (simulation%valid) call simulation%compute_md5sum ()
	end subroutine simulation_init

	@ %def simulation_init
	@ The RNG initialization depends on serial/MPI mode.
	<<Simulations: simulation init: extra variables>>=
	<<MPI: Simulations: simulation init: extra variables>>=
	integer :: rank, n_size
	<<Simulations: simulation init: extra init>>=
	<<MPI: Simulations: simulation init: extra init>>=
	call mpi_get_comm_id (n_size, rank)
	if (n_size > 1) then
	sample_suffix = var_str ("_") // str (rank)
	end if
	<<Simulations: simulation init: extra RNG init>>=
	<<MPI: Simulations: simulation init: extra RNG init>>=
	do i = 2, rank + 1
	select type (rng => simulation%rng)
	type is (rng_stream_t)
	call rng%next_substream ()
	if (i == rank) &
	call msg_message ("Simulate: Advance RNG for parallel event generation")
	class default
	call rng%write ()
	call msg_bug ("Parallel event generation: random-number generator &
	&must be 'rng_stream'.")
	end select
	end do
	@ The number of events that we want to simulate is determined by the
	settings of [[n_events]], [[luminosity]], and [[?unweighted]]. For
	weighted events, we take [[n_events]] at face value as the number of
	matrix element calls. For unweighted events, if the process is a
	decay, [[n_events]] is the number of unweighted events. In these
	cases, the luminosity setting is ignored.

	For unweighted events with a scattering process, we calculate the
	event number that corresponds to the luminosity, given the current
	value of the integral. We then compare this with [[n_events]] and
	choose the larger number.
	<<Simulations: simulation: TBP>>=
	procedure :: compute_n_events => simulation_compute_n_events
	<<Simulations: sub interfaces>>=
	module subroutine simulation_compute_n_events (simulation, n_events)
	class(simulation_t), intent(in) :: simulation
	integer, intent(out) :: n_events
	end subroutine simulation_compute_n_events
	<<Simulations: procedures>>=
	module subroutine simulation_compute_n_events (simulation, n_events)
	class(simulation_t), intent(in) :: simulation
	integer, intent(out) :: n_events
	real(default) :: lumi, x_events_lumi
	integer :: n_events_lumi
	logical :: is_scattering
	n_events = &
	simulation%local%get_ival (var_str ("n_events"))
	lumi = &
	simulation%local%get_rval (var_str ("luminosity"))
	if (simulation%unweighted) then
	is_scattering = simulation%entry(1)%n_in == 2
	if (is_scattering) then
	x_events_lumi = abs (simulation%integral * lumi)
	if (x_events_lumi < huge (n_events)) then
	n_events_lumi = nint (x_events_lumi)
	else
	call msg_message ("Simulation: luminosity too large, &
	&limiting number of events")
	n_events_lumi = huge (n_events)
	end if
	if (n_events_lumi > n_events) then
	call msg_message ("Simulation: using n_events as computed from &
	&luminosity value")
	n_events = n_events_lumi
	else
	write (msg_buffer, "(A,1x,I0)") &
	"Simulation: requested number of events =", n_events
	call msg_message ()
	if (.not. vanishes (simulation%integral)) then
	write (msg_buffer, "(A,1x,ES11.4)") &
	" corr. to luminosity [fb-1] = ", &
	n_events / simulation%integral
	call msg_message ()
	end if
	end if
	end if
	end if
	end subroutine simulation_compute_n_events

	@ %def simulation_compute_n_events
	@ Configuration of the OpenMP parameters, in case OpenMP is active. We use
	the settings accessible via the local environment.
	<<Simulations: simulation: TBP>>=
	procedure :: setup_openmp => simulation_setup_openmp
	<<Simulations: sub interfaces>>=
	module subroutine simulation_setup_openmp (simulation)
	class(simulation_t), intent(inout) :: simulation
	end subroutine simulation_setup_openmp
	<<Simulations: procedures>>=
	module subroutine simulation_setup_openmp (simulation)
	class(simulation_t), intent(inout) :: simulation

	call openmp_set_num_threads_verbose &
	(simulation%local%get_ival (var_str ("openmp_num_threads")), &
	simulation%local%get_lval (var_str ("?openmp_logging")))

	end subroutine simulation_setup_openmp

	@ %def simulation_setup_openmp
	@ Configuration of the event-stream array -- i.e., the setup of
	output file formats.
	<<Simulations: simulation: TBP>>=
	procedure :: prepare_event_streams => simulation_prepare_event_streams
	<<Simulations: sub interfaces>>=
	module subroutine simulation_prepare_event_streams (sim, es_array)
	class(simulation_t), intent(inout) :: sim
	type(event_stream_array_t), intent(out) :: es_array
	end subroutine simulation_prepare_event_streams
	<<Simulations: procedures>>=
	module subroutine simulation_prepare_event_streams (sim, es_array)
	class(simulation_t), intent(inout) :: sim
	type(event_stream_array_t), intent(out) :: es_array

	integer :: n_events
	logical :: rebuild_events, read_raw, write_raw
	integer :: checkpoint, callback
	integer :: n_fmt
	type(event_sample_data_t) :: data
	type(string_t), dimension(:), allocatable :: sample_fmt

	n_events = &
	sim%n_evt_requested
	rebuild_events = &
	sim%local%get_lval (var_str ("?rebuild_events"))
	read_raw = &
	sim%local%get_lval (var_str ("?read_raw")) .and. .not. rebuild_events
	write_raw = &
	sim%local%get_lval (var_str ("?write_raw"))
	checkpoint = &
	sim%local%get_ival (var_str ("checkpoint"))
	callback = &
	sim%local%get_ival (var_str ("event_callback_interval"))
	if (read_raw) then
	inquire (file = char (sim%sample_id) // ".evx", exist = read_raw)
	end if
	if (allocated (sim%local%sample_fmt)) then
	n_fmt = size (sim%local%sample_fmt)
	else
	n_fmt = 0
	end if
	data = sim%get_data ()
	data%n_evt = n_events
	data%nlo_multiplier = sim%get_n_nlo_entries (1)
	if (read_raw) then
	allocate (sample_fmt (n_fmt))
	if (n_fmt > 0) sample_fmt = sim%local%sample_fmt
	call es_array%init (sim%sample_id, &
	sample_fmt, sim%local, &
	data = data, &
	input = var_str ("raw"), &
	allow_switch = write_raw, &
	checkpoint = checkpoint, &
	callback = callback)
	else if (write_raw) then
	allocate (sample_fmt (n_fmt + 1))
	if (n_fmt > 0) sample_fmt(:n_fmt) = sim%local%sample_fmt
	sample_fmt(n_fmt+1) = var_str ("raw")
	call es_array%init (sim%sample_id, &
	sample_fmt, sim%local, &
	data = data, &
	checkpoint = checkpoint, &
	callback = callback)
	else if (allocated (sim%local%sample_fmt) &
	.or. checkpoint > 0 &
	.or. callback > 0) then
	allocate (sample_fmt (n_fmt))
	if (n_fmt > 0) sample_fmt = sim%local%sample_fmt
	call es_array%init (sim%sample_id, &
	sample_fmt, sim%local, &
	data = data, &
	checkpoint = checkpoint, &
	callback = callback)
	end if
	end subroutine simulation_prepare_event_streams

	@ %def simulation_prepare_event_streams
	@
	<<Simulations: simulation: TBP>>=
	procedure :: get_n_nlo_entries => simulation_get_n_nlo_entries
	<<Simulations: sub interfaces>>=
	module function simulation_get_n_nlo_entries &
	(simulation, i_prc) result (n_extra)
	class(simulation_t), intent(in) :: simulation
	integer, intent(in) :: i_prc
	integer :: n_extra
	end function simulation_get_n_nlo_entries
	<<Simulations: procedures>>=
	module function simulation_get_n_nlo_entries &
	(simulation, i_prc) result (n_extra)
	class(simulation_t), intent(in) :: simulation
	integer, intent(in) :: i_prc
	integer :: n_extra
	n_extra = simulation%entry(i_prc)%count_nlo_entries ()
	end function simulation_get_n_nlo_entries

	@ %def simulation_get_n_nlo_entries
	@ Initialize the process selector, using the entry integrals as process
	weights.
	<<Simulations: simulation: TBP>>=
	procedure :: init_process_selector => simulation_init_process_selector
	<<Simulations: sub interfaces>>=
	module subroutine simulation_init_process_selector (simulation)
	class(simulation_t), intent(inout) :: simulation
	end subroutine simulation_init_process_selector
	<<Simulations: procedures>>=
	module subroutine simulation_init_process_selector (simulation)
	class(simulation_t), intent(inout) :: simulation
	integer :: i
	if (simulation%has_integral) then
	call simulation%process_selector%init (simulation%entry%integral, &
	negative_weights = simulation%negative_weights)
	do i = 1, simulation%n_prc
	associate (entry => simulation%entry(i))
	if (.not. entry%valid) then
	call msg_warning ("Process '" // char (entry%process_id) // &
	"': matrix element vanishes, no events can be generated.")
	cycle
	end if
	call entry%init_mci_selector (simulation%negative_weights)
	entry%process_weight = simulation%process_selector%get_weight (i)
	end associate
	end do
	end if
	end subroutine simulation_init_process_selector

	@ %def simulation_init_process_selector
	@ Select a process, using the random-number generator.
	<<Simulations: simulation: TBP>>=
	procedure :: select_prc => simulation_select_prc
	<<Simulations: sub interfaces>>=
	module function simulation_select_prc (simulation) result (i_prc)
	class(simulation_t), intent(inout) :: simulation
	integer :: i_prc
	end function simulation_select_prc
	<<Simulations: procedures>>=
	module function simulation_select_prc (simulation) result (i_prc)
	class(simulation_t), intent(inout) :: simulation
	integer :: i_prc
	call simulation%process_selector%generate (simulation%rng, i_prc)
	end function simulation_select_prc

	@ %def simulation_select_prc
	@ Select a MCI set for the selected process.
	<<Simulations: simulation: TBP>>=
	procedure :: select_mci => simulation_select_mci
	<<Simulations: sub interfaces>>=
	module function simulation_select_mci (simulation) result (i_mci)
	class(simulation_t), intent(inout) :: simulation
	integer :: i_mci
	end function simulation_select_mci
	<<Simulations: procedures>>=
	module function simulation_select_mci (simulation) result (i_mci)
	class(simulation_t), intent(inout) :: simulation
	integer :: i_mci
	i_mci = 0
	if (simulation%i_prc /= 0) then
	i_mci = simulation%entry(simulation%i_prc)%select_mci ()
	end if
	end function simulation_select_mci

	@ %def simulation_select_mci
	@
	\subsubsection{Generate-event loop}
	The requested number of events should be set by this, in time for the
	event-array initializers that may use this number.
	<<Simulations: simulation: TBP>>=
	procedure :: set_n_events_requested => simulation_set_n_events_requested
	procedure :: get_n_events_requested => simulation_get_n_events_requested
	<<Simulations: sub interfaces>>=
	module subroutine simulation_set_n_events_requested (simulation, n)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: n
	end subroutine simulation_set_n_events_requested
	module function simulation_get_n_events_requested (simulation) result (n)
	class(simulation_t), intent(in) :: simulation
	integer :: n
	end function simulation_get_n_events_requested
	<<Simulations: procedures>>=
	module subroutine simulation_set_n_events_requested (simulation, n)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: n

	simulation%n_evt_requested = n

	end subroutine simulation_set_n_events_requested

	module function simulation_get_n_events_requested (simulation) result (n)
	class(simulation_t), intent(in) :: simulation
	integer :: n

	n = simulation%n_evt_requested

	end function simulation_get_n_events_requested

	@ %def simulation_set_n_events_requested
	@ %def simulation_get_n_events_requested
	@ Generate the number of events that has been set by
	[[simulation_set_n_events_requested]]. First select a process and a component
	set, then generate an event for that process and factorize the quantum state.
	The pair of random numbers can be used for factorization.

	When generating events, we drop all configurations where the event is
	marked as incomplete. This happens if the event fails cuts. In fact,
	such events are dropped already by the sampler if unweighting is in
	effect, so this can happen only for weighted events. By setting a
	limit given by [[sample_max_tries]] (user parameter), we can avoid an
	endless loop.

	The [[begin_it]] and [[end_it]] limits are equal to 1 and the number of
	events, repspectively, in serial mode, but differ for MPI mode.

	TODO: When reading from file, event transforms cannot be applied because the
	process instance will not be complete. (?)
	<<Simulations: simulation: TBP>>=
	procedure :: generate => simulation_generate
	<<Simulations: sub interfaces>>=
	module subroutine simulation_generate (simulation, es_array)
	class(simulation_t), intent(inout), target :: simulation
	type(event_stream_array_t), intent(inout), optional :: es_array
	end subroutine simulation_generate
	<<Simulations: procedures>>=
	module subroutine simulation_generate (simulation, es_array)
	class(simulation_t), intent(inout), target :: simulation
	type(event_stream_array_t), intent(inout), optional :: es_array

	integer :: begin_it, end_it
	integer :: i, j, k

	call simulation%before_first_event (begin_it, end_it, es_array)
	do i = begin_it, end_it
	call simulation%next_event (es_array)
	end do
	call simulation%after_last_event (begin_it, end_it)

	end subroutine simulation_generate

	@ %def simulation_generate
	@ The header of the event loop: with all necessary information present in the
	[[simulation]] and [[es_array]] objects, and given a number of events [[n]] to
	generate, we prepare for actually generating/reading/writing events.

	The procedure returns the real iteration bounds [[begin_it]] and [[end_it]]
	for the event loop. This is nontrivial only for MPI; in serial mode those are
	equal to 1 and to [[n_events]], respectively.
	<<Simulations: simulation: TBP>>=
	procedure :: before_first_event => simulation_before_first_event
	<<Simulations: sub interfaces>>=
	module subroutine simulation_before_first_event (simulation, &
	begin_it, end_it, es_array)
	class(simulation_t), intent(inout), target :: simulation
	integer, intent(out) :: begin_it
	integer, intent(out) :: end_it
	type(event_stream_array_t), intent(inout), optional :: es_array
	end subroutine simulation_before_first_event
	<<Simulations: procedures>>=
	module subroutine simulation_before_first_event (simulation, &
	begin_it, end_it, es_array)
	class(simulation_t), intent(inout), target :: simulation
	integer, intent(out) :: begin_it
	integer, intent(out) :: end_it
	type(event_stream_array_t), intent(inout), optional :: es_array

	integer :: n_evt_requested
	logical :: has_input
	integer :: n_events_print
	logical :: is_leading_order
	logical :: is_weighted
	logical :: is_polarized

	n_evt_requested = simulation%n_evt_requested
	n_events_print = n_evt_requested * simulation%get_n_nlo_entries (1)
	is_leading_order = (n_events_print == n_evt_requested)

	has_input = .false.
	if (present (es_array)) has_input = es_array%has_input ()

	is_weighted = .not. simulation%entry(1)%config%unweighted
	is_polarized = simulation%entry(1)%config%factorization_mode &
	/= FM_IGNORE_HELICITY

	call simulation%startup_message_generate ( &
	has_input = has_input, &
	is_weighted = is_weighted, &
	is_polarized = is_polarized, &
	is_leading_order = is_leading_order, &
	n_events = n_events_print)

	call simulation%entry%set_n (n_evt_requested)
	if (simulation%n_alt > 0) call simulation%alt_entry%set_n (n_evt_requested)
	call simulation%init_event_index ()

	begin_it = 1
	end_it = n_evt_requested
	<<Simulations: simulation generate: extra init>>

	end subroutine simulation_before_first_event

	@ %def simulation_before_first_event
	@ Keep the user informed:
	<<Simulations: simulation: TBP>>=
	procedure, private :: startup_message_generate &
	=> simulation_startup_message_generate
	<<Simulations: sub interfaces>>=
	module subroutine simulation_startup_message_generate (simulation, &
	has_input, is_weighted, is_polarized, is_leading_order, n_events)
	class(simulation_t), intent(in) :: simulation
	logical, intent(in) :: has_input
	logical, intent(in) :: is_weighted
	logical, intent(in) :: is_polarized
	logical, intent(in) :: is_leading_order
	integer, intent(in) :: n_events
	end subroutine simulation_startup_message_generate
	<<Simulations: procedures>>=
	module subroutine simulation_startup_message_generate (simulation, &
	has_input, is_weighted, is_polarized, is_leading_order, n_events)
	class(simulation_t), intent(in) :: simulation
	logical, intent(in) :: has_input
	logical, intent(in) :: is_weighted
	logical, intent(in) :: is_polarized
	logical, intent(in) :: is_leading_order
	integer, intent(in) :: n_events

	type(string_t) :: str1, str2, str3, str4

	if (has_input) then
	str1 = "Events: reading"
	else
	str1 = "Events: generating"
	end if
	if (is_weighted) then
	str2 = "weighted"
	else
	str2 = "unweighted"
	end if
	if (is_polarized) then
	str3 = ", polarized"
	else
	str3 = ", unpolarized"
	end if
	str4 = ""
	if (.not. is_leading_order) str4 = " NLO"

	write (msg_buffer, "(A,1X,I0,1X,A,1X,A)") char (str1), n_events, &
	char (str2) // char(str3) // char(str4), "events ..."
	call msg_message ()

	write (msg_buffer, "(A,1x,A)") "Events: event normalization mode", &
	char (event_normalization_string (simulation%norm_mode))
	call msg_message ()

	end subroutine simulation_startup_message_generate

	@ %def simulation_startup_message_generate
	@
	The body of the event loop: generate and process a single event.

	Optionally transfer the current event to one of the provided event handles,
	for in and/or output streams. This works for any stream for which the I/O
	stream type matches the event-handle type.
	<<Simulations: simulation: TBP>>=
	procedure :: next_event => simulation_next_event
	<<Simulations: sub interfaces>>=
	module subroutine simulation_next_event &
	(simulation, es_array, event_handle_out, event_handle_in)
	class(simulation_t), intent(inout) :: simulation
	type(event_stream_array_t), intent(inout), optional :: es_array
	class(event_handle_t), intent(inout), optional :: event_handle_out
	class(event_handle_t), intent(inout), optional :: event_handle_in
	end subroutine simulation_next_event
	<<Simulations: procedures>>=
	module subroutine simulation_next_event &
	(simulation, es_array, event_handle_out, event_handle_in)
	class(simulation_t), intent(inout) :: simulation
	type(event_stream_array_t), intent(inout), optional :: es_array
	class(event_handle_t), intent(inout), optional :: event_handle_out
	class(event_handle_t), intent(inout), optional :: event_handle_in

	type(entry_t), pointer :: current_entry
	logical :: generate_new
	logical :: passed
	integer :: j, k

	call simulation%increment_event_index ()

	if (present (es_array)) then
	call simulation%read_event &
	(es_array, .true., generate_new, event_handle_in)
	else
	generate_new = .true.
	end if

	if (generate_new) then
	simulation%i_prc = simulation%select_prc ()
	simulation%i_mci = simulation%select_mci ()

	associate (entry => simulation%entry(simulation%i_prc))

	entry%instance%i_mci = simulation%i_mci
	call entry%set_active_real_components ()
	current_entry => entry%get_first ()

	do k = 1, current_entry%count_nlo_entries ()
	if (k > 1) then
	current_entry => current_entry%get_next ()
	current_entry%particle_set => current_entry%first%particle_set
	current_entry%particle_set_is_valid &
	= current_entry%first%particle_set_is_valid
	end if
	do j = 1, simulation%n_max_tries
	if (.not. current_entry%valid) call msg_warning &
	("Process '" // char (current_entry%process_id) // "': " // &
	"matrix element vanishes, no events can be generated.")
	call current_entry%generate (simulation%i_mci, i_nlo = k)
	if (signal_is_pending ()) return
	call simulation%counter%record_mean_and_variance &
	(current_entry%weight_prc, k)
	if (current_entry%has_valid_particle_set ()) exit
	end do
	end do
	if (entry%is_nlo ()) call entry%reset_nlo_counter ()

	if (.not. entry%has_valid_particle_set ()) then
	write (msg_buffer, "(A,I0,A)") "Simulation: failed to &
	&generate valid event after ", &
	simulation%n_max_tries, " tries (sample_max_tries)"
	call msg_fatal ()
	end if

	current_entry => entry%get_first ()
	do k = 1, current_entry%count_nlo_entries ()
	if (k > 1) current_entry => current_entry%get_next ()
	call current_entry%set_index (simulation%get_event_index ())
	call current_entry%evaluate_expressions ()
	end do
	if (signal_is_pending ()) return

	simulation%n_dropped = entry%get_n_dropped ()
	if (entry%passed_selection ()) then
	simulation%weight = entry%get_weight_ref ()
	simulation%excess = entry%get_excess_prc ()
	end if
	call simulation%counter%record &
	(simulation%weight, simulation%excess, simulation%n_dropped)
	call entry%record (simulation%i_mci)

	end associate

	else

	associate (entry => simulation%entry(simulation%i_prc))

	call simulation%set_event_index (entry%get_index ())
	call entry%accept_sqme_ref ()
	call entry%accept_weight_ref ()
	call entry%check ()
	call entry%evaluate_expressions ()
	if (signal_is_pending ()) return

	simulation%n_dropped = entry%get_n_dropped ()
	if (entry%passed_selection ()) then
	simulation%weight = entry%get_weight_ref ()
	simulation%excess = entry%get_excess_prc ()
	end if
	call simulation%counter%record &
	(simulation%weight, simulation%excess, simulation%n_dropped, &
	from_file=.true.)
	call entry%record (simulation%i_mci, from_file=.true.)

	end associate

	end if

	call simulation%calculate_alt_entries ()
	if (simulation%pacify) call pacify (simulation)
	if (signal_is_pending ()) return

	if (simulation%respect_selection) then
	passed = simulation%entry(simulation%i_prc)%passed_selection ()
	else
	passed = .true.
	end if
	if (present (es_array)) then
	call simulation%write_event (es_array, passed, event_handle_out)
	end if

	end subroutine simulation_next_event

	@ %def simulation_next_event
	@ Cleanup after last event: compute and show summary information.
	<<Simulations: simulation: TBP>>=
	procedure :: after_last_event => simulation_after_last_event
	<<Simulations: sub interfaces>>=
	module subroutine simulation_after_last_event (simulation, begin_it, end_it)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: begin_it, end_it
	end subroutine simulation_after_last_event
	<<Simulations: procedures>>=
	module subroutine simulation_after_last_event (simulation, begin_it, end_it)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: begin_it, end_it

	call msg_message (" ... event sample complete.")
	<<Simulations: simulation generate: extra finalize>>

	if (simulation%unweighted) call simulation%show_efficiency ()
	call simulation%counter%show_excess ()
	call simulation%counter%show_dropped ()
	call simulation%counter%show_mean_and_variance ()

	end subroutine simulation_after_last_event

	@ %def simulation_after_last_event
	@
	\subsubsection{MPI additions}
	Below, we define code chunks that differ between the serial and MPI versions.

	Extra logging for MPI only.
	<<Simulations: simulation: TBP>>=
	procedure :: activate_extra_logging => simulation_activate_extra_logging
	<<Simulations: sub interfaces>>=
	module subroutine simulation_activate_extra_logging (simulation)
	class(simulation_t), intent(in) :: simulation
	end subroutine simulation_activate_extra_logging
	<<Simulations: procedures>>=
	module subroutine simulation_activate_extra_logging (simulation)
	class(simulation_t), intent(in) :: simulation
	<<Simulations: activate extra logging>>
	end subroutine simulation_activate_extra_logging

	<<Simulations: activate extra logging>>=
	<<MPI: Simulations: activate extra logging>>=
	logical :: mpi_logging
	integer :: rank, n_size
	call mpi_get_comm_id (n_size, rank)
	mpi_logging = &
	(simulation%local%get_sval (var_str ("$integration_method")) == "vamp2" &
	.and. n_size > 1) &
	.or. simulation%local%get_lval (var_str ("?mpi_logging"))
	call mpi_set_logging (mpi_logging)
	@ %def simulation_activate_extra_logging
	@
	Extra subroutine to be called before the first event:
	<<Simulations: simulation generate: extra init>>=
	<<MPI: Simulations: simulation generate: extra init>>=
	call simulation%init_event_loop_mpi (n_evt_requested, begin_it, end_it)
	@
	Extra subroutine to be called after the last event:
	<<Simulations: simulation generate: extra finalize>>=
	<<MPI: Simulations: simulation generate: extra finalize>>=
	call simulation%final_event_loop_mpi (begin_it, end_it)
	@
	For MPI event generation, the event-loop interval (1\dots n) is split up
	into intervals of [[n_workers]].
	<<MPI: Simulations: simulation: TBP>>=
	procedure, private :: init_event_loop_mpi => simulation_init_event_loop_mpi
	<<MPI: Simulations: sub interfaces>>=
	module subroutine simulation_init_event_loop_mpi &
	(simulation, n_events, begin_it, end_it)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: n_events
	integer, intent(out) :: begin_it, end_it
	end subroutine simulation_init_event_loop_mpi
	<<MPI: Simulations: procedures>>=
	module subroutine simulation_init_event_loop_mpi &
	(simulation, n_events, begin_it, end_it)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: n_events
	integer, intent(out) :: begin_it, end_it

	integer :: rank, n_workers

	call MPI_COMM_SIZE (MPI_COMM_WORLD, n_workers)
	if (n_workers < 2) then
	begin_it = 1; end_it = n_events
	return
	end if
	call MPI_COMM_RANK (MPI_COMM_WORLD, rank)
	if (rank == 0) then
	call compute_and_scatter_intervals (n_events, begin_it, end_it)
	else
	call retrieve_intervals (begin_it, end_it)
	end if

	!! Event index starts by 0 (before incrementing when the first event gets generated/read in).
	!! Proof: event_index_offset in [0, N], start_it in [1, N].
	simulation%event_index_offset = simulation%event_index_offset + (begin_it - 1)
	call simulation%init_event_index ()
	write (msg_buffer, "(A,I0,A,I0,A)") &
	& "MPI: generate events [", begin_it, ":", end_it, "]"
	call msg_message ()

	contains

	subroutine compute_and_scatter_intervals (n_events, begin_it, end_it)
	integer, intent(in) :: n_events
	integer, intent(out) :: begin_it, end_it

	integer, dimension(:), allocatable :: all_begin_it, all_end_it
	integer :: rank, n_workers, n_events_per_worker

	call MPI_COMM_RANK (MPI_COMM_WORLD, rank)
	call MPI_COMM_SIZE (MPI_COMM_WORLD, n_workers)
	allocate (all_begin_it (n_workers), source = 1)
	allocate (all_end_it (n_workers), source = n_events)
	n_events_per_worker = floor (real (n_events, default) / n_workers)
	all_begin_it = [(1 + rank * n_events_per_worker, rank = 0, n_workers - 1)]
	all_end_it = [(rank * n_events_per_worker, rank = 1, n_workers)]
	all_end_it(n_workers) = n_events
	call MPI_SCATTER (all_begin_it, 1, MPI_INTEGER, begin_it, 1, MPI_INTEGER, 0, MPI_COMM_WORLD)
	call MPI_SCATTER (all_end_it, 1, MPI_INTEGER, end_it, 1, MPI_INTEGER, 0, MPI_COMM_WORLD)

	end subroutine compute_and_scatter_intervals

	subroutine retrieve_intervals (begin_it, end_it)
	integer, intent(out) :: begin_it, end_it

	integer :: local_begin_it, local_end_it

	call MPI_SCATTER (local_begin_it, 1, MPI_INTEGER, begin_it, 1, MPI_INTEGER, 0, MPI_COMM_WORLD)
	call MPI_SCATTER (local_end_it, 1, MPI_INTEGER, end_it, 1, MPI_INTEGER, 0, MPI_COMM_WORLD)

	end subroutine retrieve_intervals

	end subroutine simulation_init_event_loop_mpi

	@ %def simulation_init_event_loop_mpi
	@
	Synchronize, reduce and collect stuff after the event loop has completed.
	<<MPI: Simulations: simulation: TBP>>=
	procedure, private :: final_event_loop_mpi => simulation_final_event_loop_mpi
	<<MPI: Simulations: sub interfaces>>=
	module subroutine simulation_final_event_loop_mpi &
	(simulation, begin_it, end_it)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: begin_it, end_it
	end subroutine simulation_final_event_loop_mpi
	<<MPI: Simulations: procedures>>=
	module subroutine simulation_final_event_loop_mpi &
	(simulation, begin_it, end_it)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: begin_it, end_it

	integer :: n_workers, n_events_local, n_events_global

	call MPI_Barrier (MPI_COMM_WORLD)
	call MPI_COMM_SIZE (MPI_COMM_WORLD, n_workers)
	if (n_workers < 2) return
	n_events_local = end_it - begin_it + 1
	call MPI_ALLREDUCE (n_events_local, n_events_global, 1, &
	MPI_INTEGER, MPI_SUM,&
	& MPI_COMM_WORLD)
	write (msg_buffer, "(2(A,1X,I0))") &
	"MPI: Number of generated events locally", n_events_local, &
	" and in world", n_events_global
	call msg_message ()
	call simulation%counter%allreduce_record ()

	end subroutine simulation_final_event_loop_mpi

	@ %def simulation_final_event_loop_mpi
	@
	\subsubsection{Alternate environments}
	Compute the event matrix element and weight for all alternative
	environments, given the current event and selected process. We first
	copy the particle set, then temporarily update the process core with
	local parameters, recalculate everything, and restore the process
	core.

	The event weight is obtained by rescaling the original event weight with the
	ratio of the new and old [[sqme]] values. (In particular, if the old
	value was zero, the weight will stay zero.)

	Note: this may turn out to be inefficient because we always replace
	all parameters and recalculate everything, once for each event and
	environment. However, a more fine-grained control requires more
	code. In any case, while we may keep multiple process cores (which
	stay constant for a simulation run), we still have to update the
	external matrix element parameters event by event. The matrix element
	``object'' is present only once.
	<<Simulations: simulation: TBP>>=
	procedure :: calculate_alt_entries => simulation_calculate_alt_entries
	<<Simulations: sub interfaces>>=
	module subroutine simulation_calculate_alt_entries (simulation)
	class(simulation_t), intent(inout) :: simulation
	end subroutine simulation_calculate_alt_entries
	<<Simulations: procedures>>=
	module subroutine simulation_calculate_alt_entries (simulation)
	class(simulation_t), intent(inout) :: simulation
	real(default) :: sqme_prc, weight_prc, factor
	real(default), dimension(:), allocatable :: sqme_alt, weight_alt
	integer :: n_alt, i, j
	i = simulation%i_prc
	n_alt = simulation%n_alt
	if (n_alt == 0) return
	allocate (sqme_alt (n_alt), weight_alt (n_alt))
	associate (entry => simulation%entry(i))
	do j = 1, n_alt
	if (signal_is_pending ()) return
	if (simulation%update_weight) then
	factor = entry%get_kinematical_weight ()
	else
	sqme_prc = entry%get_sqme_prc ()
	weight_prc = entry%get_weight_prc ()
	if (sqme_prc /= 0) then
	factor = weight_prc / sqme_prc
	else
	factor = 0
	end if
	end if
	associate (alt_entry => simulation%alt_entry(i,j))
	call alt_entry%update_process (saved=.false.)
	call alt_entry%select &
	(entry%get_i_mci (), entry%get_i_term (), entry%get_channel ())
	call alt_entry%fill_particle_set (entry)
	call alt_entry%recalculate &
	(update_sqme = .true., &
	recover_beams = simulation%recover_beams, &
	weight_factor = factor)
	if (signal_is_pending ()) return
	call alt_entry%accept_sqme_prc ()
	call alt_entry%update_normalization ()
	call alt_entry%accept_weight_prc ()
	call alt_entry%check ()
	call alt_entry%set_index (simulation%get_event_index ())
	call alt_entry%evaluate_expressions ()
	if (signal_is_pending ()) return
	sqme_alt(j) = alt_entry%get_sqme_ref ()
	if (alt_entry%passed_selection ()) then
	weight_alt(j) = alt_entry%get_weight_ref ()
	end if
	end associate
	end do
	call entry%update_process (saved=.false.)
	call entry%set (sqme_alt = sqme_alt, weight_alt = weight_alt)
	call entry%check ()
	call entry%store_alt_values ()
	end associate
	end subroutine simulation_calculate_alt_entries

	@ %def simulation_calculate_alt_entries
	@
	These routines take care of temporary parameter redefinitions that
	we want to take effect while recalculating the matrix elements. We
	extract the core(s) of the processes that we are simulating, apply the
	changes, and make sure that the changes are actually used. This is
	the duty of [[dispatch_core_update]]. When done, we restore the
	original versions using [[dispatch_core_restore]].
	<<Simulations: simulation: TBP>>=
	procedure :: update_processes => simulation_update_processes
	procedure :: restore_processes => simulation_restore_processes
	<<Simulations: sub interfaces>>=
	module subroutine simulation_update_processes (simulation, &
	model, qcd, helicity_selection)
	class(simulation_t), intent(inout) :: simulation
	class(model_data_t), intent(in), optional, target :: model
	type(qcd_t), intent(in), optional :: qcd
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	end subroutine simulation_update_processes
	module subroutine simulation_restore_processes (simulation)
	class(simulation_t), intent(inout) :: simulation
	end subroutine simulation_restore_processes
	<<Simulations: procedures>>=
	module subroutine simulation_update_processes (simulation, &
	model, qcd, helicity_selection)
	class(simulation_t), intent(inout) :: simulation
	class(model_data_t), intent(in), optional, target :: model
	type(qcd_t), intent(in), optional :: qcd
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	integer :: i
	do i = 1, simulation%n_prc
	call simulation%entry(i)%update_process &
	(model, qcd, helicity_selection)
	end do
	end subroutine simulation_update_processes

	module subroutine simulation_restore_processes (simulation)
	class(simulation_t), intent(inout) :: simulation
	integer :: i
	do i = 1, simulation%n_prc
	call simulation%entry(i)%restore_process ()
	end do
	end subroutine simulation_restore_processes

	@ %def simulation_update_processes
	@ %def simulation_restore_processes
	@
	\subsubsection{Rescan-Events Loop}
	Rescan an undefined number of events.

	If [[update_event]] or [[update_sqme]] is set, we have to recalculate the
	event, starting from the particle set. If the latter is set, this includes
	the squared matrix element (i.e., the amplitude is evaluated). Otherwise,
	only kinematics and observables derived from it are recovered.

	If any of the update flags is set, we will come up with separate
	[[sqme_prc]] and [[weight_prc]] values. (The latter is only distinct
	if [[update_weight]] is set.) Otherwise, we accept the reference values.
	<<Simulations: simulation: TBP>>=
	procedure :: rescan => simulation_rescan
	<<Simulations: sub interfaces>>=
	module subroutine simulation_rescan (simulation, n, es_array, global)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: n
	type(event_stream_array_t), intent(inout) :: es_array
	type(rt_data_t), intent(inout) :: global
	end subroutine simulation_rescan
	<<Simulations: procedures>>=
	module subroutine simulation_rescan (simulation, n, es_array, global)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: n
	type(event_stream_array_t), intent(inout) :: es_array
	type(rt_data_t), intent(inout) :: global
	type(qcd_t) :: qcd
	type(string_t) :: str1, str2, str3
	logical :: complete, check_match
	str1 = "Rescanning"
	if (simulation%entry(1)%config%unweighted) then
	str2 = "unweighted"
	else
	str2 = "weighted"
	end if
	simulation%n_evt_requested = n
	call simulation%entry%set_n (n)
	if (simulation%update_sqme .or. simulation%update_weight) then
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call simulation%update_processes &
	(global%model, qcd, global%get_helicity_selection ())
	str3 = "(process parameters updated) "
	else
	str3 = ""
	end if
	write (msg_buffer, "(A,1x,A,1x,A,A,A)") char (str1), char (str2), &
	"events ", char (str3), "..."
	call msg_message ()
	call simulation%init_event_index ()
	check_match = .not. global%var_list%get_lval (var_str ("?rescan_force"))
	do
	call simulation%increment_event_index ()
	call simulation%read_event (es_array, .false., complete)
	if (complete) exit
	if (simulation%update_event &
	.or. simulation%update_sqme &
	.or. simulation%update_weight) then
	call simulation%recalculate (check_match = check_match)
	if (signal_is_pending ()) return
	associate (entry => simulation%entry(simulation%i_prc))
	call entry%update_normalization ()
	if (simulation%update_event) then
	call entry%evaluate_transforms ()
	end if
	call entry%check ()
	call entry%evaluate_expressions ()
	if (signal_is_pending ()) return
	simulation%n_dropped = entry%get_n_dropped ()
	simulation%weight = entry%get_weight_prc ()
	call simulation%counter%record &
	(simulation%weight, n_dropped=simulation%n_dropped, from_file=.true.)
	call entry%record (simulation%i_mci, from_file=.true.)
	end associate
	else
	associate (entry => simulation%entry(simulation%i_prc))
	call entry%accept_sqme_ref ()
	call entry%accept_weight_ref ()
	call entry%check ()
	call entry%evaluate_expressions ()
	if (signal_is_pending ()) return
	simulation%n_dropped = entry%get_n_dropped ()
	simulation%weight = entry%get_weight_ref ()
	call simulation%counter%record &
	(simulation%weight, n_dropped=simulation%n_dropped, from_file=.true.)
	call entry%record (simulation%i_mci, from_file=.true.)
	end associate
	end if
	call simulation%calculate_alt_entries ()
	if (signal_is_pending ()) return
	call simulation%write_event (es_array)
	end do
	call simulation%counter%show_dropped ()
	if (simulation%update_sqme .or. simulation%update_weight) then
	call simulation%restore_processes ()
	end if
	end subroutine simulation_rescan

	@ %def simulation_rescan
	@
	\subsubsection{Event index}
	Here we handle the event index that is kept in the simulation record. The
	event index is valid for the current sample. When generating or reading
	events, we initialize the index with the offset that the user provides (if any)
	and increment it for each event that is generated or read from file. The event
	index is stored in the event-entry that is current for the event. If an
	event on file comes with its own index, that index overwrites the predefined
	one and also resets the index within the simulation record.

	The event index is not connected to the [[counter]] object. The counter is
	supposed to collect statistical information. The event index is a user-level
	object that is visible in event records and analysis expressions.
	<<Simulations: simulation: TBP>>=
	procedure :: init_event_index => simulation_init_event_index
	procedure :: increment_event_index => simulation_increment_event_index
	procedure :: set_event_index => simulation_set_event_index
	procedure :: get_event_index => simulation_get_event_index
	<<Simulations: sub interfaces>>=
	module subroutine simulation_init_event_index (simulation)
	class(simulation_t), intent(inout) :: simulation
	end subroutine simulation_init_event_index
	module subroutine simulation_increment_event_index (simulation)
	class(simulation_t), intent(inout) :: simulation
	end subroutine simulation_increment_event_index
	module subroutine simulation_set_event_index (simulation, i)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: i
	end subroutine simulation_set_event_index
	module function simulation_get_event_index (simulation) result (i)
	class(simulation_t), intent(in) :: simulation
	integer :: i
	end function simulation_get_event_index
	<<Simulations: procedures>>=
	module subroutine simulation_init_event_index (simulation)
	class(simulation_t), intent(inout) :: simulation
	call simulation%set_event_index (simulation%event_index_offset)
	end subroutine simulation_init_event_index

	module subroutine simulation_increment_event_index (simulation)
	class(simulation_t), intent(inout) :: simulation
	if (simulation%event_index_set) then
	simulation%event_index = simulation%event_index + 1
	end if
	end subroutine simulation_increment_event_index

	module subroutine simulation_set_event_index (simulation, i)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: i
	simulation%event_index = i
	simulation%event_index_set = .true.
	end subroutine simulation_set_event_index

	module function simulation_get_event_index (simulation) result (i)
	class(simulation_t), intent(in) :: simulation
	integer :: i
	if (simulation%event_index_set) then
	i = simulation%event_index
	else
	i = 0
	end if
	end function simulation_get_event_index

	@ %def simulation_init_event_index
	@ %def simulation_increment_event_index
	@ %def simulation_set_event_index
	@ %def simulation_get_event_index
	@
	\subsection{Direct event access}
	If we want to retrieve event information, we should expose the currently
	selected event [[entry]] within the simulation object. We recall that this is
	an extension of the (generic) [[event]] type. Assuming that we will restrict
	this to read access, we return a pointer.
	<<Simulations: simulation: TBP>>=
	procedure :: get_process_index => simulation_get_process_index
	procedure :: get_event_ptr => simulation_get_event_ptr
	<<Simulations: sub interfaces>>=
	module function simulation_get_process_index (simulation) result (i_prc)
	class(simulation_t), intent(in), target :: simulation
	integer :: i_prc
	end function simulation_get_process_index
	module function simulation_get_event_ptr (simulation) result (event)
	class(simulation_t), intent(in), target :: simulation
	class(event_t), pointer :: event
	end function simulation_get_event_ptr
	<<Simulations: procedures>>=
	module function simulation_get_process_index (simulation) result (i_prc)
	class(simulation_t), intent(in), target :: simulation
	integer :: i_prc

	i_prc = simulation%i_prc

	end function simulation_get_process_index

	module function simulation_get_event_ptr (simulation) result (event)
	class(simulation_t), intent(in), target :: simulation
	class(event_t), pointer :: event

	event => simulation%entry(simulation%i_prc)

	end function simulation_get_event_ptr

	@ %def simulation_get_process_index
	@ %def simulation_get_event_ptr
	@
	\subsection{Event Stream I/O}
	Write an event to a generic [[eio]] event stream. The process index
	must be selected, or the current index must be available.
	<<Simulations: simulation: TBP>>=
	generic :: write_event => write_event_eio
	procedure :: write_event_eio => simulation_write_event_eio
	<<Simulations: sub interfaces>>=
	module subroutine simulation_write_event_eio (object, eio, i_prc)
	class(simulation_t), intent(in) :: object
	class(eio_t), intent(inout) :: eio
	integer, intent(in), optional :: i_prc
	end subroutine simulation_write_event_eio
	<<Simulations: procedures>>=
	module subroutine simulation_write_event_eio (object, eio, i_prc)
	class(simulation_t), intent(in) :: object
	class(eio_t), intent(inout) :: eio
	integer, intent(in), optional :: i_prc
	logical :: increased
	integer :: current
	if (present (i_prc)) then
	current = i_prc
	else
	current = object%i_prc
	end if
	if (current > 0) then
	if (object%split_n_evt > 0 .and. object%counter%total > 1) then
	if (mod (object%counter%total, object%split_n_evt) == 1) then
	call eio%split_out ()
	end if
	else if (object%split_n_kbytes > 0) then
	call eio%update_split_count (increased)
	if (increased) call eio%split_out ()
	end if
	call eio%output (object%entry(current)%event_t, current, pacify = object%pacify)
	else
	call msg_fatal ("Simulation: write event: no process selected")
	end if
	end subroutine simulation_write_event_eio

	@ %def simulation_write_event
	@
	Read an event from a generic [[eio]] event stream. The event stream element
	must specify the process within the sample ([[i_prc]]), the MC group for this
	process ([[i_mci]]), the selected term ([[i_term]]), the selected MC
	integration [[channel]], and the particle set of the event.

	We may encounter EOF, which we indicate by storing 0 for the process index
	[[i_prc]]. An I/O error will be reported, and we also abort reading.
	<<Simulations: simulation: TBP>>=
	generic :: read_event => read_event_eio
	procedure :: read_event_eio => simulation_read_event_eio
	<<Simulations: sub interfaces>>=
	module subroutine simulation_read_event_eio (object, eio)
	class(simulation_t), intent(inout) :: object
	class(eio_t), intent(inout) :: eio
	end subroutine simulation_read_event_eio
	<<Simulations: procedures>>=
	module subroutine simulation_read_event_eio (object, eio)
	class(simulation_t), intent(inout) :: object
	class(eio_t), intent(inout) :: eio
	integer :: iostat, current
	call eio%input_i_prc (current, iostat)
	select case (iostat)
	case (0)
	object%i_prc = current
	call eio%input_event (object%entry(current)%event_t, iostat)
	end select
	select case (iostat)
	case (:-1)
	object%i_prc = 0
	object%i_mci = 0
	case (1:)
	call msg_error ("Reading events: I/O error, aborting read")
	object%i_prc = 0
	object%i_mci = 0
	case default
	object%i_mci = object%entry(current)%get_i_mci ()
	end select
	end subroutine simulation_read_event_eio

	@ %def simulation_read_event
	@
	\subsection{Event Stream Array}
	Write an event using an array of event I/O streams.
	The process index must be selected, or the current index must be
	available.
	<<Simulations: simulation: TBP>>=
	generic :: write_event => write_event_es_array
	procedure :: write_event_es_array => simulation_write_event_es_array
	<<Simulations: sub interfaces>>=
	module subroutine simulation_write_event_es_array &
	(object, es_array, passed, event_handle)
	class(simulation_t), intent(in), target :: object
	class(event_stream_array_t), intent(inout) :: es_array
	logical, intent(in), optional :: passed
	class(event_handle_t), intent(inout), optional :: event_handle
	end subroutine simulation_write_event_es_array
	<<Simulations: procedures>>=
	module subroutine simulation_write_event_es_array &
	(object, es_array, passed, event_handle)
	class(simulation_t), intent(in), target :: object
	class(event_stream_array_t), intent(inout) :: es_array
	logical, intent(in), optional :: passed
	class(event_handle_t), intent(inout), optional :: event_handle
	integer :: i_prc, event_index
	integer :: i
	type(entry_t), pointer :: current_entry
	i_prc = object%i_prc
	if (i_prc > 0) then
	event_index = object%counter%total
	current_entry => object%entry(i_prc)%get_first ()
	do i = 1, current_entry%count_nlo_entries ()
	if (i > 1) current_entry => current_entry%get_next ()
	call es_array%output (current_entry%event_t, i_prc, &
	event_index, &
	passed = passed, &
	pacify = object%pacify, &
	event_handle = event_handle)
	end do
	else
	call msg_fatal ("Simulation: write event: no process selected")
	end if
	end subroutine simulation_write_event_es_array

	@ %def simulation_write_event
	@ Read an event using an array of event I/O streams. Reading is
	successful if there is an input stream within the array, and if a
	valid event can be read from that stream. If there is a stream, but
	EOF is passed when reading the first item, we switch the channel to
	output and return failure but no error message, such that new events
	can be appended to that stream.
	<<Simulations: simulation: TBP>>=
	generic :: read_event => read_event_es_array
	procedure :: read_event_es_array => simulation_read_event_es_array
	<<Simulations: sub interfaces>>=
	module subroutine simulation_read_event_es_array &
	(object, es_array, enable_switch, fail, event_handle)
	class(simulation_t), intent(inout), target :: object
	class(event_stream_array_t), intent(inout), target :: es_array
	logical, intent(in) :: enable_switch
	logical, intent(out) :: fail
	class(event_handle_t), intent(inout), optional :: event_handle
	end subroutine simulation_read_event_es_array
	<<Simulations: procedures>>=
	module subroutine simulation_read_event_es_array &
	(object, es_array, enable_switch, fail, event_handle)
	class(simulation_t), intent(inout), target :: object
	class(event_stream_array_t), intent(inout), target :: es_array
	logical, intent(in) :: enable_switch
	logical, intent(out) :: fail
	class(event_handle_t), intent(inout), optional :: event_handle
	integer :: iostat, i_prc
	type(entry_t), pointer :: current_entry => null ()
	integer :: i
	if (es_array%has_input ()) then
	fail = .false.
	call es_array%input_i_prc (i_prc, iostat)
	select case (iostat)
	case (0)
	object%i_prc = i_prc
	current_entry => object%entry(i_prc)
	do i = 1, current_entry%count_nlo_entries ()
	if (i > 1) then
	call es_array%skip_eio_entry (iostat)
	current_entry => current_entry%get_next ()
	end if
	call current_entry%set_index (object%get_event_index ())
	call es_array%input_event &
	(current_entry%event_t, iostat, event_handle)
	end do
	case (:-1)
	write (msg_buffer, "(A,1x,I0,1x,A)") &
	"... event file terminates after", &
	object%counter%read, "events."
	call msg_message ()
	if (enable_switch) then
	call es_array%switch_inout ()
	write (msg_buffer, "(A,1x,I0,1x,A)") &
	"Generating remaining ", &
	object%n_evt_requested - object%counter%read, "events ..."
	call msg_message ()
	end if
	fail = .true.
	return
	end select
	select case (iostat)
	case (0)
	object%i_mci = object%entry(i_prc)%get_i_mci ()
	case default
	write (msg_buffer, "(A,1x,I0,1x,A)") &
	"Reading events: I/O error, aborting read after", &
	object%counter%read, "events."
	call msg_error ()
	object%i_prc = 0
	object%i_mci = 0
	fail = .true.
	end select
	else
	fail = .true.
	end if
	end subroutine simulation_read_event_es_array

	@ %def simulation_read_event
	@
	\subsection{Recover event}
	Recalculate the process instance contents, given an event with known particle
	set. The indices for MC, term, and channel must be already set. The
	[[recalculate]] method of the selected entry will import the result
	into [[sqme_prc]] and [[weight_prc]].

	If [[recover_phs]] is set (and false), do not attempt any phase-space
	calculation. Useful if we need only matrix elements (esp. testing); this flag
	is not stored in the simulation record.
	<<Simulations: simulation: TBP>>=
	procedure :: recalculate => simulation_recalculate
	<<Simulations: sub interfaces>>=
	module subroutine simulation_recalculate &
	(simulation, recover_phs, check_match)
	class(simulation_t), intent(inout) :: simulation
	logical, intent(in), optional :: recover_phs
	logical, intent(in), optional :: check_match
	end subroutine simulation_recalculate
	<<Simulations: procedures>>=
	module subroutine simulation_recalculate &
	(simulation, recover_phs, check_match)
	class(simulation_t), intent(inout) :: simulation
	logical, intent(in), optional :: recover_phs
	logical, intent(in), optional :: check_match
	integer :: i_prc, i_comp, i_term, k
	integer :: i_mci, i_mci0, i_mci1
	integer, dimension(:), allocatable :: i_terms
	logical :: success
	i_prc = simulation%i_prc
	associate (entry => simulation%entry(i_prc))
	if (entry%selected_i_mci /= 0) then
	i_mci0 = entry%selected_i_mci
	i_mci1 = i_mci0
	else
	i_mci0 = 1
	i_mci1 = entry%process%get_n_mci ()
	end if
	SCAN_COMP: do i_mci = i_mci0, i_mci1
	i_comp = entry%process%get_master_component (i_mci)
	call entry%process%reset_selected_cores ()
	call entry%process%select_components ([i_comp])
	i_terms = entry%process%get_component_i_terms (i_comp)
	SCAN_TERM: do k = 1, size (i_terms)
	i_term = i_terms(k)
	call entry%select (i_mci, i_term, entry%selected_channel)
	if (entry%selected_i_term /= 0 &
	.and. entry%selected_i_term /= i_term) cycle SCAN_TERM
	call entry%select (i_mci, i_term, entry%selected_channel)
	if (simulation%update_weight) then
	call entry%recalculate &
	(update_sqme = simulation%update_sqme, &
	recover_beams = simulation%recover_beams, &
	recover_phs = recover_phs, &
	weight_factor = entry%get_kinematical_weight (), &
	check_match = check_match, &
	success = success)
	else
	call entry%recalculate &
	(update_sqme = simulation%update_sqme, &
	recover_beams = simulation%recover_beams, &
	recover_phs = recover_phs, &
	check_match = check_match, &
	success = success)
	end if
	if (success) exit SCAN_COMP
	end do SCAN_TERM
	deallocate (i_terms)
	end do SCAN_COMP
	if (.not. success) then
	call entry%write ()
	call msg_fatal ("Simulation/recalculate: &
	&event could not be matched to the specified process")
	end if
	end associate
	end subroutine simulation_recalculate

	@ %def simulation_recalculate
	@
	\subsection{Extract contents of the simulation object}
	Return the MD5 sum that summarizes configuration and integration
	(but not the event file). Used for initializing the event streams.
	<<Simulations: simulation: TBP>>=
	procedure :: get_md5sum_prc => simulation_get_md5sum_prc
	procedure :: get_md5sum_cfg => simulation_get_md5sum_cfg
	procedure :: get_md5sum_alt => simulation_get_md5sum_alt
	<<Simulations: sub interfaces>>=
	module function simulation_get_md5sum_prc (simulation) result (md5sum)
	class(simulation_t), intent(in) :: simulation
	character(32) :: md5sum
	end function simulation_get_md5sum_prc
	module function simulation_get_md5sum_cfg (simulation) result (md5sum)
	class(simulation_t), intent(in) :: simulation
	character(32) :: md5sum
	end function simulation_get_md5sum_cfg
	module function simulation_get_md5sum_alt (simulation, i) result (md5sum)
	class(simulation_t), intent(in) :: simulation
	integer, intent(in) :: i
	character(32) :: md5sum
	end function simulation_get_md5sum_alt
	<<Simulations: procedures>>=
	module function simulation_get_md5sum_prc (simulation) result (md5sum)
	class(simulation_t), intent(in) :: simulation
	character(32) :: md5sum
	md5sum = simulation%md5sum_prc
	end function simulation_get_md5sum_prc

	module function simulation_get_md5sum_cfg (simulation) result (md5sum)
	class(simulation_t), intent(in) :: simulation
	character(32) :: md5sum
	md5sum = simulation%md5sum_cfg
	end function simulation_get_md5sum_cfg

	module function simulation_get_md5sum_alt (simulation, i) result (md5sum)
	class(simulation_t), intent(in) :: simulation
	integer, intent(in) :: i
	character(32) :: md5sum
	md5sum = simulation%md5sum_alt(i)
	end function simulation_get_md5sum_alt

	@ %def simulation_get_md5sum_prc
	@ %def simulation_get_md5sum_cfg
	@
	Return data that may be useful for writing event files.

	Usually we can refer to a previously integrated process, for which we
	can fetch a process pointer. Occasionally, we do not have this because
	we are just rescanning an externally generated file without
	calculation. For that situation, we generate our local beam data object
	using the current enviroment, or, in simple cases, just fetch the
	necessary data from the process definition and environment.
	<<Simulations: simulation: TBP>>=
	procedure :: get_data => simulation_get_data
	<<Simulations: sub interfaces>>=
	module function simulation_get_data (simulation, alt) result (sdata)
	class(simulation_t), intent(in) :: simulation
	logical, intent(in), optional :: alt
	type(event_sample_data_t) :: sdata
	end function simulation_get_data
	<<Simulations: procedures>>=
	module function simulation_get_data (simulation, alt) result (sdata)
	class(simulation_t), intent(in) :: simulation
	logical, intent(in), optional :: alt
	type(event_sample_data_t) :: sdata
	type(process_t), pointer :: process
	type(beam_data_t), pointer :: beam_data
	type(beam_structure_t), pointer :: beam_structure
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: n, i
	logical :: enable_alt, construct_beam_data
	real(default) :: sqrts
	class(model_data_t), pointer :: model
	logical :: decay_rest_frame
	type(string_t) :: process_id
	enable_alt = .true.; if (present (alt)) enable_alt = alt
	if (debug_on) call msg_debug (D_CORE, "simulation_get_data")
	if (debug_on) call msg_debug (D_CORE, "alternative setup", enable_alt)
	if (enable_alt) then
	call sdata%init (simulation%n_prc, simulation%n_alt)
	do i = 1, simulation%n_alt
	sdata%md5sum_alt(i) = simulation%get_md5sum_alt (i)
	end do
	else
	call sdata%init (simulation%n_prc)
	end if
	sdata%unweighted = simulation%unweighted
	sdata%negative_weights = simulation%negative_weights
	sdata%norm_mode = simulation%norm_mode
	process => simulation%entry(1)%get_process_ptr ()
	if (associated (process)) then
	beam_data => process%get_beam_data_ptr ()
	construct_beam_data = .false.
	else
	n = simulation%entry(1)%n_in
	sqrts = simulation%local%get_sqrts ()
	beam_structure => simulation%local%beam_structure
	call beam_structure%check_against_n_in (n, construct_beam_data)
	if (construct_beam_data) then
	allocate (beam_data)
	model => simulation%local%model
	decay_rest_frame = &
	simulation%local%get_lval (var_str ("?decay_rest_frame"))
	call beam_data%init_structure (beam_structure, &
	sqrts, model, decay_rest_frame)
	else
	beam_data => null ()
	end if
	end if
	if (associated (beam_data)) then
	n = beam_data%get_n_in ()
	sdata%n_beam = n
	allocate (flv (n))
	flv = beam_data%get_flavor ()
	sdata%pdg_beam(:n) = flv%get_pdg ()
	sdata%energy_beam(:n) = beam_data%get_energy ()
	if (construct_beam_data) deallocate (beam_data)
	else
	n = simulation%entry(1)%n_in
	sdata%n_beam = n
	process_id = simulation%entry(1)%process_id
	call simulation%local%prclib%get_pdg_in_1 &
	(process_id, sdata%pdg_beam(:n))
	sdata%energy_beam(:n) = sqrts / n
	end if
	do i = 1, simulation%n_prc
	if (.not. simulation%entry(i)%valid) cycle
	process => simulation%entry(i)%get_process_ptr ()
	if (associated (process)) then
	sdata%proc_num_id(i) = process%get_num_id ()
	else
	process_id = simulation%entry(i)%process_id
	sdata%proc_num_id(i) = simulation%local%prclib%get_num_id (process_id)
	end if
	if (sdata%proc_num_id(i) == 0) sdata%proc_num_id(i) = i
	if (simulation%entry(i)%has_integral) then
	sdata%cross_section(i) = simulation%entry(i)%integral
	sdata%error(i) = simulation%entry(i)%error
	end if
	end do
	sdata%total_cross_section = sum (sdata%cross_section)
	sdata%md5sum_prc = simulation%get_md5sum_prc ()
	sdata%md5sum_cfg = simulation%get_md5sum_cfg ()
	if (simulation%split_n_evt > 0 .or. simulation%split_n_kbytes > 0) then
	sdata%split_n_evt = simulation%split_n_evt
	sdata%split_n_kbytes = simulation%split_n_kbytes
	sdata%split_index = simulation%split_index
	end if
	end function simulation_get_data

	@ %def simulation_get_data
	@ Return a default name for the current event sample. This is the
	process ID of the first process.
	<<Simulations: simulation: TBP>>=
	procedure :: get_default_sample_name => simulation_get_default_sample_name
	<<Simulations: sub interfaces>>=
	module function simulation_get_default_sample_name &
	(simulation) result (sample)
	class(simulation_t), intent(in) :: simulation
	type(string_t) :: sample
	end function simulation_get_default_sample_name
	<<Simulations: procedures>>=
	module function simulation_get_default_sample_name &
	(simulation) result (sample)
	class(simulation_t), intent(in) :: simulation
	type(string_t) :: sample
	type(process_t), pointer :: process
	sample = "whizard"
	if (simulation%n_prc > 0) then
	process => simulation%entry(1)%get_process_ptr ()
	if (associated (process)) then
	sample = process%get_id ()
	end if
	end if
	end function simulation_get_default_sample_name

	@ %def simulation_get_default_sample_name
	@
	<<Simulations: simulation: TBP>>=
	procedure :: is_valid => simulation_is_valid
	<<Simulations: sub interfaces>>=
	module function simulation_is_valid (simulation) result (valid)
	class(simulation_t), intent(inout) :: simulation
	logical :: valid
	end function simulation_is_valid
	<<Simulations: procedures>>=
	module function simulation_is_valid (simulation) result (valid)
	class(simulation_t), intent(inout) :: simulation
	logical :: valid
	valid = simulation%valid
	end function simulation_is_valid

	@ %def simulation_is_valid
	@
	Return the hard-interaction particle set for event entry [[i_prc]].
	<<Simulations: simulation: TBP>>=
	procedure :: get_hard_particle_set => simulation_get_hard_particle_set
	<<Simulations: sub interfaces>>=
	module function simulation_get_hard_particle_set &
	(simulation, i_prc) result (pset)
	class(simulation_t), intent(in) :: simulation
	integer, intent(in) :: i_prc
	type(particle_set_t) :: pset
	end function simulation_get_hard_particle_set
	<<Simulations: procedures>>=
	module function simulation_get_hard_particle_set &
	(simulation, i_prc) result (pset)
	class(simulation_t), intent(in) :: simulation
	integer, intent(in) :: i_prc
	type(particle_set_t) :: pset
	call simulation%entry(i_prc)%get_hard_particle_set (pset)
	end function simulation_get_hard_particle_set

	@ %def simulation_get_hard_particle_set
	@
	\subsection{Auxiliary}
	Call pacify: eliminate numerical noise.
	<<Simulations: public>>=
	public :: pacify
	<<Simulations: interfaces>>=
	interface pacify
	module procedure pacify_simulation
	end interface
	<<Simulations: sub interfaces>>=
	module subroutine pacify_simulation (simulation)
	class(simulation_t), intent(inout) :: simulation
	end subroutine pacify_simulation
	<<Simulations: procedures>>=
	module subroutine pacify_simulation (simulation)
	class(simulation_t), intent(inout) :: simulation
	integer :: i, j
	i = simulation%i_prc
	if (i > 0) then
	call pacify (simulation%entry(i))
	do j = 1, simulation%n_alt
	call pacify (simulation%alt_entry(i,j))
	end do
	end if
	end subroutine pacify_simulation

	@ %def pacify_simulation
	@ Manually evaluate expressions for the currently selected process.
	This is used only in the unit tests.
	<<Simulations: simulation: TBP>>=
	procedure :: evaluate_expressions => simulation_evaluate_expressions
	<<Simulations: sub interfaces>>=
	module subroutine simulation_evaluate_expressions (simulation)
	class(simulation_t), intent(inout) :: simulation
	end subroutine simulation_evaluate_expressions
	<<Simulations: procedures>>=
	module subroutine simulation_evaluate_expressions (simulation)
	class(simulation_t), intent(inout) :: simulation
	call simulation%entry(simulation%i_prc)%evaluate_expressions ()
	end subroutine simulation_evaluate_expressions

	@ %def simulation_evaluate_expressions
	@ Manually evaluate event transforms for the currently selected
	process. This is used only in the unit tests.
	<<Simulations: simulation: TBP>>=
	procedure :: evaluate_transforms => simulation_evaluate_transforms
	<<Simulations: sub interfaces>>=
	module subroutine simulation_evaluate_transforms (simulation)
	class(simulation_t), intent(inout) :: simulation
	end subroutine simulation_evaluate_transforms
	<<Simulations: procedures>>=
	module subroutine simulation_evaluate_transforms (simulation)
	class(simulation_t), intent(inout) :: simulation
	associate (entry => simulation%entry(simulation%i_prc))
	call entry%evaluate_transforms ()
	end associate
	end subroutine simulation_evaluate_transforms

	@ %def simulation_evaluate_transforms
	@
	\subsection{Unit tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[simulations_ut.f90]]>>=
	<<File header>>

	module simulations_ut
	use unit_tests
	use simulations_uti

	<<Standard module head>>

	<<Simulations: public test>>

	contains

	<<Simulations: test driver>>

	end module simulations_ut
	@ %def simulations_ut
	@
	<<[[simulations_uti.f90]]>>=
	<<File header>>

	module simulations_uti

	<<Use kinds>>
	use kinds, only: i64
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_10, FMT_12
	use ifiles
	use lexers
	use parser
	use lorentz
	use flavors
	use interactions, only: reset_interaction_counter
	use process_libraries, only: process_library_t
	use prclib_stacks
	use phs_forests
	use event_base, only: generic_event_t
	use event_base, only: event_callback_t
	use particles, only: particle_set_t
	use eio_data
	use eio_base
	use eio_direct, only: eio_direct_t
	use eio_raw
	use eio_ascii
	use eio_dump
	use eio_callback
	use eval_trees
	use model_data, only: model_data_t
	use models
	use rt_data
	use event_streams
	use decays_ut, only: prepare_testbed
	use process, only: process_t
	use process_stacks, only: process_entry_t
	use process_configurations_ut, only: prepare_test_library
	use compilations, only: compile_library
	use integrations, only: integrate_process

	use simulations

	use restricted_subprocesses_uti, only: prepare_resonance_test_library

	<<Standard module head>>

	<<Simulations: test declarations>>

	<<Simulations: test auxiliary types>>

	contains

	<<Simulations: tests>>

	<<Simulations: test auxiliary>>

	end module simulations_uti

	@ %def simulations_uti
	@ API: driver for the unit tests below.
	<<Simulations: public test>>=
	public :: simulations_test
	<<Simulations: test driver>>=
	subroutine simulations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Simulations: execute tests>>
	end subroutine simulations_test

	@ %def simulations_test
	@
	\subsubsection{Initialization}
	Initialize a [[simulation_t]] object, including the embedded event records.
	<<Simulations: execute tests>>=
	call test (simulations_1, "simulations_1", &
	"initialization", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_1
	<<Simulations: tests>>=
	subroutine simulations_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, procname2
	type(rt_data_t), target :: global
	type(simulation_t), target :: simulation

	write (u, "(A)") "* Test output: simulations_1"
	write (u, "(A)") "* Purpose: initialize simulation"
	write (u, "(A)")

	write (u, "(A)") "* Initialize processes"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_1a"
	procname1 = "simulation_1p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	procname2 = "sim_extra"

	call prepare_test_library (global, libname, 1, [procname2])
	call compile_library (libname, global)
	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations2"), is_known = .true.)


	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_string (var_str ("$sample"), &
	var_str ("sim1"), is_known = .true.)
	call integrate_process (procname2, global, local_stack=.true.)

	call simulation%init ([procname1, procname2], .false., .true., global)
	call simulation%init_process_selector ()
	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the first process"
	write (u, "(A)")

	call simulation%write_event (u, i_prc = 1)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_1"

	end subroutine simulations_1

	@ %def simulations_1
	@
	\subsubsection{Weighted events}
	Generate events for a single process.
	<<Simulations: execute tests>>=
	call test (simulations_2, "simulations_2", &
	"weighted events", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_2
	<<Simulations: tests>>=
	subroutine simulations_2 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1
	type(rt_data_t), target :: global
	type(simulation_t), target :: simulation
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: simulations_2"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)")

	write (u, "(A)") "* Initialize processes"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_2a"
	procname1 = "simulation_2p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	data = simulation%get_data ()
	call data%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate three events"
	write (u, "(A)")

	call simulation%set_n_events_requested (3)
	call simulation%generate ()
	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the last event"
	write (u, "(A)")

	call simulation%write_event (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_2"

	end subroutine simulations_2

	@ %def simulations_2
	@
	\subsubsection{Unweighted events}
	Generate events for a single process.
	<<Simulations: execute tests>>=
	call test (simulations_3, "simulations_3", &
	"unweighted events", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_3
	<<Simulations: tests>>=
	subroutine simulations_3 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1
	type(rt_data_t), target :: global
	type(simulation_t), target :: simulation
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: simulations_3"
	write (u, "(A)") "* Purpose: generate unweighted events &
	&for a single process"
	write (u, "(A)")

	write (u, "(A)") "* Initialize processes"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_3a"
	procname1 = "simulation_3p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	data = simulation%get_data ()
	call data%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate three events"
	write (u, "(A)")

	call simulation%set_n_events_requested (3)
	call simulation%generate ()
	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the last event"
	write (u, "(A)")

	call simulation%write_event (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_3"

	end subroutine simulations_3

	@ %def simulations_3
	@
	\subsubsection{Simulating process with structure functions}
	Generate events for a single process.
	<<Simulations: execute tests>>=
	call test (simulations_4, "simulations_4", &
	"process with structure functions", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_4
	<<Simulations: tests>>=
	subroutine simulations_4 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1
	type(rt_data_t), target :: global
	type(flavor_t) :: flv
	type(string_t) :: name
	type(simulation_t), target :: simulation
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: simulations_4"
	write (u, "(A)") "* Purpose: generate events for a single process &
	&with structure functions"
	write (u, "(A)")

	write (u, "(A)") "* Initialize processes"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_4a"
	procname1 = "simulation_4p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call reset_interaction_counter ()

	call flv%init (25, global%model)
	name = flv%get_name ()

	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

	write (u, "(A)") "* Integrate"
	write (u, "(A)")

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	call global%set_string (var_str ("$sample"), &
	var_str ("simulations4"), is_known = .true.)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	data = simulation%get_data ()
	call data%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate three events"
	write (u, "(A)")

	call simulation%set_n_events_requested (3)
	call simulation%generate ()
	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the last event"
	write (u, "(A)")

	call simulation%write_event (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_4"

	end subroutine simulations_4

	@ %def simulations_4
	@
	\subsubsection{Event I/O}
	Generate event for a test process, write to file and reread.
	<<Simulations: execute tests>>=
	call test (simulations_5, "simulations_5", &
	"raw event I/O", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_5
	<<Simulations: tests>>=
	subroutine simulations_5 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	class(eio_t), allocatable :: eio
	type(simulation_t), allocatable, target :: simulation

	write (u, "(A)") "* Test output: simulations_5"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* write to file and reread"
	write (u, "(A)")

	write (u, "(A)") "* Initialize processes"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_5a"
	procname1 = "simulation_5p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations5"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations5"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	write (u, "(A)") "* Initialize raw event file"
	write (u, "(A)")

	allocate (eio_raw_t :: eio)
	call eio%init_out (sample)

	write (u, "(A)") "* Generate an event"
	write (u, "(A)")

	call simulation%set_n_events_requested (1)
	call simulation%generate ()
	call simulation%write_event (u)
	call simulation%write_event (eio)

	call eio%final ()
	deallocate (eio)
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)")
	write (u, "(A)") "* Re-read the event from file"
	write (u, "(A)")

	call global%set_log (var_str ("?update_sqme"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_weight"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()
	allocate (eio_raw_t :: eio)
	call eio%init_in (sample)

	call simulation%read_event (eio)
	call simulation%write_event (u)

	write (u, "(A)")
	write (u, "(A)") "* Recalculate process instance"
	write (u, "(A)")

	call simulation%recalculate ()
	call simulation%evaluate_expressions ()
	call simulation%write_event (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call eio%final ()
	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_5"

	end subroutine simulations_5

	@ %def simulations_5
	@
	\subsubsection{Event I/O}
	Generate event for a real process with structure functions, write to file and
	reread.
	<<Simulations: execute tests>>=
	call test (simulations_6, "simulations_6", &
	"raw event I/O with structure functions", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_6
	<<Simulations: tests>>=
	subroutine simulations_6 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	class(eio_t), allocatable :: eio
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	type(string_t) :: name

	write (u, "(A)") "* Test output: simulations_6"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* write to file and reread"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_6"
	procname1 = "simulation_6p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)

	call flv%init (25, global%model)
	name = flv%get_name ()

	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations6"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	write (u, "(A)") "* Initialize raw event file"
	write (u, "(A)")

	allocate (eio_raw_t :: eio)
	call eio%init_out (sample)

	write (u, "(A)") "* Generate an event"
	write (u, "(A)")

	call simulation%set_n_events_requested (1)
	call simulation%generate ()
	call pacify (simulation)
	call simulation%write_event (u, verbose = .true., testflag = .true.)
	call simulation%write_event (eio)

	call eio%final ()
	deallocate (eio)
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)")
	write (u, "(A)") "* Re-read the event from file"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?update_sqme"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_weight"), &
	.true., is_known = .true.)

	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()
	allocate (eio_raw_t :: eio)
	call eio%init_in (sample)

	call simulation%read_event (eio)
	call simulation%write_event (u, verbose = .true., testflag = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Recalculate process instance"
	write (u, "(A)")

	call simulation%recalculate ()
	call simulation%evaluate_expressions ()
	call simulation%write_event (u, verbose = .true., testflag = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call eio%final ()
	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_6"

	end subroutine simulations_6

	@ %def simulations_6
	@
	\subsubsection{Automatic Event I/O}
	Generate events with raw-format event file as cache: generate, reread,
	append.
	<<Simulations: execute tests>>=
	call test (simulations_7, "simulations_7", &
	"automatic raw event I/O", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_7
	<<Simulations: tests>>=
	subroutine simulations_7 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: empty_string_array
	type(event_sample_data_t) :: data
	type(event_stream_array_t) :: es_array
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	type(string_t) :: name

	write (u, "(A)") "* Test output: simulations_7"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* write to file and reread"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_7"
	procname1 = "simulation_7p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)

	call flv%init (25, global%model)
	name = flv%get_name ()

	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations7"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	write (u, "(A)") "* Initialize raw event file"
	write (u, "(A)")

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = simulation%get_md5sum_cfg ()
	call es_array%init (sample, [var_str ("raw")], global, data)

	write (u, "(A)") "* Generate an event"
	write (u, "(A)")

	call simulation%set_n_events_requested (1)
	call simulation%generate (es_array)

	call es_array%final ()
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)") "* Re-read the event from file and generate another one"
	write (u, "(A)")

	call global%set_log (&
	var_str ("?rebuild_events"), .false., is_known = .true.)

	call reset_interaction_counter ()

	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = simulation%get_md5sum_cfg ()
	call es_array%init (sample, empty_string_array, global, data, &
	input = var_str ("raw"))

	call simulation%set_n_events_requested (2)
	call simulation%generate (es_array)

	call pacify (simulation)
	call simulation%write_event (u, verbose = .true.)

	call es_array%final ()
	call simulation%final ()
	deallocate (simulation)


	write (u, "(A)")
	write (u, "(A)") "* Re-read both events from file"
	write (u, "(A)")

	call reset_interaction_counter ()

	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = simulation%get_md5sum_cfg ()
	call es_array%init (sample, empty_string_array, global, data, &
	input = var_str ("raw"))

	call simulation%set_n_events_requested (2)
	call simulation%generate (es_array)

	call pacify (simulation)
	call simulation%write_event (u, verbose = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call es_array%final ()
	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_7"

	end subroutine simulations_7

	@ %def simulations_7
	@
	\subsubsection{Rescanning Events}
	Generate events and rescan the resulting raw event file.
	<<Simulations: execute tests>>=
	call test (simulations_8, "simulations_8", &
	"rescan raw event file", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_8
	<<Simulations: tests>>=
	subroutine simulations_8 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: empty_string_array
	type(event_sample_data_t) :: data
	type(event_stream_array_t) :: es_array
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	type(string_t) :: name

	write (u, "(A)") "* Test output: simulations_8"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* write to file and rescan"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_8"
	procname1 = "simulation_8p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)

	call flv%init (25, global%model)
	name = flv%get_name ()

	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations8"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	write (u, "(A)") "* Initialize raw event file"
	write (u, "(A)")

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = simulation%get_md5sum_cfg ()
	write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
	write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
	call es_array%init (sample, [var_str ("raw")], global, &
	data)

	write (u, "(A)")
	write (u, "(A)") "* Generate an event"
	write (u, "(A)")

	call simulation%set_n_events_requested (1)
	call simulation%generate (es_array)

	call pacify (simulation)
	call simulation%write_event (u, verbose = .true., testflag = .true.)

	call es_array%final ()
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)")
	write (u, "(A)") "* Re-read the event from file"
	write (u, "(A)")

	call reset_interaction_counter ()

	allocate (simulation)
	call simulation%init ([procname1], .false., .false., global)
	call simulation%init_process_selector ()

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = ""
	write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
	write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
	call es_array%init (sample, empty_string_array, global, data, &
	input = var_str ("raw"), input_sample = sample, allow_switch = .false.)

	call simulation%rescan (1, es_array, global = global)

	write (u, "(A)")

	call pacify (simulation)
	call simulation%write_event (u, verbose = .true., testflag = .true.)

	call es_array%final ()
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)")
	write (u, "(A)") "* Re-read again and recalculate"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?update_sqme"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_event"), &
	.true., is_known = .true.)

	allocate (simulation)
	call simulation%init ([procname1], .false., .false., global)
	call simulation%init_process_selector ()

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = ""
	write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
	write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
	call es_array%init (sample, empty_string_array, global, data, &
	input = var_str ("raw"), input_sample = sample, allow_switch = .false.)

	call simulation%rescan (1, es_array, global = global)

	write (u, "(A)")

	call pacify (simulation)
	call simulation%write_event (u, verbose = .true., testflag = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call es_array%final ()
	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_8"

	end subroutine simulations_8

	@ %def simulations_8
	@
	\subsubsection{Rescanning Check}
	Generate events and rescan with process mismatch.
	<<Simulations: execute tests>>=
	call test (simulations_9, "simulations_9", &
	"rescan mismatch", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_9
	<<Simulations: tests>>=
	subroutine simulations_9 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: empty_string_array
	type(event_sample_data_t) :: data
	type(event_stream_array_t) :: es_array
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	type(string_t) :: name
	logical :: error

	write (u, "(A)") "* Test output: simulations_9"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* write to file and rescan"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_9"
	procname1 = "simulation_9p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)

	call flv%init (25, global%model)
	name = flv%get_name ()

	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations9"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize raw event file"
	write (u, "(A)")

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = simulation%get_md5sum_cfg ()
	write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
	write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
	call es_array%init (sample, [var_str ("raw")], global, &
	data)

	write (u, "(A)")
	write (u, "(A)") "* Generate an event"
	write (u, "(A)")

	call simulation%set_n_events_requested (1)
	call simulation%generate (es_array)

	call es_array%final ()
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)") "* Initialize event generation for different parameters"
	write (u, "(A)")

	call reset_interaction_counter ()

	allocate (simulation)
	call simulation%init ([procname1, procname1], .false., .false., global)
	call simulation%init_process_selector ()

	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Attempt to re-read the events (should fail)"
	write (u, "(A)")

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = ""
	write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
	write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
	call es_array%init (sample, empty_string_array, global, data, &
	input = var_str ("raw"), input_sample = sample, &
	allow_switch = .false., error = error)

	write (u, "(1x,A,L1)") "error = ", error

	call simulation%rescan (1, es_array, global = global)

	call es_array%final ()
	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_9"

	end subroutine simulations_9

	@ %def simulations_9
	@
	\subsubsection{Alternative weights}
	Generate an event for a single process and reweight it in a
	simultaneous calculation.
	<<Simulations: execute tests>>=
	call test (simulations_10, "simulations_10", &
	"alternative weight", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_10
	<<Simulations: tests>>=
	subroutine simulations_10 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, expr_text
	type(rt_data_t), target :: global
	type(rt_data_t), dimension(1), target :: alt_env
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: pt_weight
	type(simulation_t), target :: simulation
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: simulations_10"
	write (u, "(A)") "* Purpose: reweight event"
	write (u, "(A)")

	write (u, "(A)") "* Initialize processes"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_pexpr_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_10a"
	procname1 = "simulation_10p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize alternative environment with custom weight"
	write (u, "(A)")

	call alt_env(1)%local_init (global)
	call alt_env(1)%activate ()

	expr_text = "2"
	write (u, "(A,A)") "weight = ", char (expr_text)
	write (u, *)

	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_weight, stream, .true.)
	call stream_final (stream)
	alt_env(1)%pn%weight_expr => pt_weight%get_root_ptr ()
	call alt_env(1)%write_expr (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	call simulation%init ([procname1], .true., .true., global, alt_env=alt_env)
	call simulation%init_process_selector ()

	data = simulation%get_data ()
	call data%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate an event"
	write (u, "(A)")

	call simulation%set_n_events_requested (1)
	call simulation%generate ()
	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the last event"
	write (u, "(A)")

	call simulation%write_event (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the alternative setup"
	write (u, "(A)")

	call simulation%write_alt_event (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call simulation%final ()
	call global%final ()

	call syntax_model_file_final ()
	call syntax_pexpr_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_10"

	end subroutine simulations_10

	@ %def simulations_10
	@
	\subsubsection{Decays}
	Generate an event with subsequent partonic decays.
	<<Simulations: execute tests>>=
	call test (simulations_11, "simulations_11", &
	"decay", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_11
	<<Simulations: tests>>=
	subroutine simulations_11 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(prclib_entry_t), pointer :: lib
	type(string_t) :: prefix, procname1, procname2
	type(simulation_t), target :: simulation

	write (u, "(A)") "* Test output: simulations_11"
	write (u, "(A)") "* Purpose: apply decay"
	write (u, "(A)")

	write (u, "(A)") "* Initialize processes"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	allocate (lib)
	call global%add_prclib (lib)

	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	prefix = "simulation_11"
	procname1 = prefix // "_p"
	procname2 = prefix // "_d"
	call prepare_testbed &
	(global%prclib, global%process_stack, &
	prefix, global%os_data, &
	scattering=.true., decay=.true.)

	call global%select_model (var_str ("Test"))
	call global%model%set_par (var_str ("ff"), 0.4_default)
	call global%model%set_par (var_str ("mf"), &
	global%model%get_real (var_str ("ff")) &
	* global%model%get_real (var_str ("ms")))
	call global%model%set_unstable (25, [procname2])

	write (u, "(A)") "* Initialize simulation object"
	write (u, "(A)")

	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	write (u, "(A)") "* Generate event"
	write (u, "(A)")

	call simulation%set_n_events_requested (1)
	call simulation%generate ()
	call simulation%write (u)

	write (u, *)

	call simulation%write_event (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"
	write (u, "(A)")

	call simulation%final ()
	call global%final ()

	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_11"

	end subroutine simulations_11

	@ %def simulations_11
	@
	\subsubsection{Split Event Files}
	Generate event for a real process with structure functions and write to file,
	accepting a limit for the number of events per file.
	<<Simulations: execute tests>>=
	call test (simulations_12, "simulations_12", &
	"split event files", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_12
	<<Simulations: tests>>=
	subroutine simulations_12 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	class(eio_t), allocatable :: eio
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	integer :: i_evt

	write (u, "(A)") "* Test output: simulations_12"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* and write to split event files"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_12"
	procname1 = "simulation_12p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)

	call flv%init (25, global%model)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations_12"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	call global%set_int (var_str ("sample_split_n_evt"), &
	2, is_known = .true.)
	call global%set_int (var_str ("sample_split_index"), &
	42, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize ASCII event file"
	write (u, "(A)")

	allocate (eio_ascii_short_t :: eio)
	select type (eio)
	class is (eio_ascii_t); call eio%set_parameters ()
	end select
	call eio%init_out (sample, data = simulation%get_data ())

	write (u, "(A)") "* Generate 5 events, distributed among three files"

	do i_evt = 1, 5
	call simulation%set_n_events_requested (1)
	call simulation%generate ()
	call simulation%write_event (eio)
	end do

	call eio%final ()
	deallocate (eio)
	call simulation%final ()
	deallocate (simulation)

	write (u, *)
	call display_file ("simulations_12.42.short.evt", u)
	write (u, *)
	call display_file ("simulations_12.43.short.evt", u)
	write (u, *)
	call display_file ("simulations_12.44.short.evt", u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_12"

	end subroutine simulations_12

	@ %def simulations_12
	@ Auxiliary: display file contents.
	<<Simulations: public test auxiliary>>=
	public :: display_file
	<<Simulations: test auxiliary>>=
	subroutine display_file (file, u)
	use io_units, only: free_unit
	character(*), intent(in) :: file
	integer, intent(in) :: u
	character(256) :: buffer
	integer :: u_file
	write (u, "(3A)") "* Contents of file '", file, "':"
	write (u, *)
	u_file = free_unit ()
	open (u_file, file = file, action = "read", status = "old")
	do
	read (u_file, "(A)", end = 1) buffer
	write (u, "(A)") trim (buffer)
	end do
	1 continue
	end subroutine display_file

	@ %def display_file
	@
	\subsubsection{Callback}
	Generate events and execute a callback in place of event I/O.
	<<Simulations: execute tests>>=
	call test (simulations_13, "simulations_13", &
	"callback", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_13
	<<Simulations: tests>>=
	subroutine simulations_13 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	class(eio_t), allocatable :: eio
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	integer :: i_evt
	type(simulations_13_callback_t) :: event_callback

	write (u, "(A)") "* Test output: simulations_13"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* and execute callback"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_13"
	procname1 = "simulation_13p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call flv%init (25, global%model)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations_13"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)

	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	write (u, "(A)") "* Prepare callback object"
	write (u, "(A)")

	event_callback%u = u
	call global%set_event_callback (event_callback)

	write (u, "(A)") "* Initialize callback I/O object"
	write (u, "(A)")

	allocate (eio_callback_t :: eio)
	select type (eio)
	class is (eio_callback_t)
	call eio%set_parameters (callback = event_callback, &
	count_interval = 3)
	end select
	call eio%init_out (sample, data = simulation%get_data ())

	write (u, "(A)") "* Generate 7 events, with callback every 3 events"
	write (u, "(A)")

	do i_evt = 1, 7
	call simulation%set_n_events_requested (1)
	call simulation%generate ()
	call simulation%write_event (eio)
	end do

	call eio%final ()
	deallocate (eio)
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_13"

	end subroutine simulations_13

	@ %def simulations_13
	@ The callback object and procedure. In the type extension, we can
	store the output channel [[u]] so we know where to write into.
	<<Simulations: test auxiliary types>>=
	type, extends (event_callback_t) :: simulations_13_callback_t
	integer :: u
	contains
	procedure :: write => simulations_13_callback_write
	procedure :: proc => simulations_13_callback
	end type simulations_13_callback_t

	@ %def simulations_13_callback_t
	<<Simulations: test auxiliary>>=
	subroutine simulations_13_callback_write (event_callback, unit)
	class(simulations_13_callback_t), intent(in) :: event_callback
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Hello"
	end subroutine simulations_13_callback_write

	subroutine simulations_13_callback (event_callback, i, event)
	class(simulations_13_callback_t), intent(in) :: event_callback
	integer(i64), intent(in) :: i
	class(generic_event_t), intent(in) :: event
	write (event_callback%u, "(A,I0)") "hello event #", i
	end subroutine simulations_13_callback

	@ %def simulations_13_callback_write
	@ %def simulations_13_callback
	@
	\subsubsection{Resonant subprocess setup}
	Prepare a process with resonances and enter resonant subprocesses in
	the simulation object. Select a kinematics configuration and compute
	probabilities for resonant subprocesses.

	The process and its initialization is taken from [[processes_18]], but
	we need a complete \oMega\ matrix element here.
	<<Simulations: execute tests>>=
	call test (simulations_14, "simulations_14", &
	"resonant subprocesses evaluation", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_14
	<<Simulations: tests>>=
	subroutine simulations_14 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, libname_generated
	type(string_t) :: procname
	type(string_t) :: model_name
	type(rt_data_t), target :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(simulation_t), target :: simulation
	type(particle_set_t) :: pset
	type(eio_direct_t) :: eio_in
	type(eio_dump_t) :: eio_out
	real(default) :: sqrts, mw, pp
	real(default), dimension(3) :: p3
	type(vector4_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: m
	integer :: u_verbose, i
	real(default) :: sqme_proc
	real(default), dimension(:), allocatable :: sqme
	real(default) :: on_shell_limit
	integer, dimension(:), allocatable :: i_array
	real(default), dimension(:), allocatable :: prob_array

	write (u, "(A)") "* Test output: simulations_14"
	write (u, "(A)") "* Purpose: construct resonant subprocesses &
	&in the simulation object"
	write (u, "(A)")

	write (u, "(A)") "* Build and load a test library with one process"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	libname = "simulations_14_lib"
	procname = "simulations_14_p"

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?update_sqme"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_weight"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_event"), &
	.true., is_known = .true.)

	model_name = "SM"
	call global%select_model (model_name)
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize simulation object &
	&with resonant subprocesses"
	write (u, "(A)")

	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)
	call global%set_real (var_str ("resonance_on_shell_limit"), &
	10._default, is_known = .true.)

	call simulation%init ([procname], &
	integrate=.false., generate=.false., local=global)

	call simulation%write_resonant_subprocess_data (u, 1)

	write (u, "(A)")
	write (u, "(A)") "* Resonant subprocesses: generated library"
	write (u, "(A)")

	libname_generated = procname // "_R"
	lib => global%prclib_stack%get_library_ptr (libname_generated)
	if (associated (lib)) call lib%write (u, libpath=.false.)

	write (u, "(A)")
	write (u, "(A)") "* Generated process stack"
	write (u, "(A)")

	call global%process_stack%show (u)

	write (u, "(A)")
	write (u, "(A)") "* Particle set"
	write (u, "(A)")

	pset = simulation%get_hard_particle_set (1)
	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize object for direct access"
	write (u, "(A)")

	call eio_in%init_direct &
	(n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 3, &
	pdg = [-11, 11, 1, -2, 24], model=global%model)
	call eio_in%set_selection_indices (1, 1, 1, 1)

	sqrts = global%get_rval (var_str ("sqrts"))
	mw = 80._default ! deliberately slightly different from true mw
	pp = sqrt (sqrts*2 - 4 mw**2) / 2

	allocate (p (5), m (5))
	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	m(1) = 0
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	m(2) = 0
	p3(1) = pp/2
	p3(2) = mw/2
	p3(3) = 0
	p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(3) = 0
	p3(2) = -mw/2
	p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(4) = 0
	p(5) = vector4_moving (sqrts/2,-pp, 1)
	m(5) = mw
	call eio_in%set_momentum (p, m**2)

	call eio_in%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Transfer and show particle set"
	write (u, "(A)")

	call simulation%read_event (eio_in)
	pset = simulation%get_hard_particle_set (1)
	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (Re)calculate matrix element"
	write (u, "(A)")

	call simulation%recalculate (recover_phs = .false.)
	call simulation%evaluate_transforms ()

	write (u, "(A)") "* Show event with sqme"
	write (u, "(A)")

	call eio_out%set_parameters (unit = u, &
	weights = .true., pacify = .true., compressed = .true.)
	call eio_out%init_out (var_str (""))
	call simulation%write_event (eio_out)

	write (u, "(A)")
	write (u, "(A)") "* Write event to separate file &
	&'simulations_14_event_verbose.log'"

	u_verbose = free_unit ()
	open (unit = u_verbose, file = "simulations_14_event_verbose.log", &
	status = "replace", action = "write")
	call simulation%write (u_verbose)
	write (u_verbose, *)
	call simulation%write_event (u_verbose, verbose =.true., testflag = .true.)
	close (u_verbose)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_14"

	end subroutine simulations_14

	@ %def simulations_14
	@
	\subsubsection{Resonant subprocess simulation}
	Prepare a process with resonances and enter resonant subprocesses in
	the simulation object. Simulate events with selection of resonance
	histories.

	The process and its initialization is taken from [[processes_18]], but
	we need a complete \oMega\ matrix element here.
	<<Simulations: execute tests>>=
	call test (simulations_15, "simulations_15", &
	"resonant subprocesses in simulation", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_15
	<<Simulations: tests>>=
	subroutine simulations_15 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, libname_generated
	type(string_t) :: procname
	type(string_t) :: model_name
	type(rt_data_t), target :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(simulation_t), target :: simulation
	real(default) :: sqrts
	type(eio_dump_t) :: eio_out
	integer :: u_verbose

	write (u, "(A)") "* Test output: simulations_15"
	write (u, "(A)") "* Purpose: generate event with resonant subprocess"
	write (u, "(A)")

	write (u, "(A)") "* Build and load a test library with one process"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	libname = "simulations_15_lib"
	procname = "simulations_15_p"

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?update_sqme"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_weight"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_event"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)
	call global%set_real (var_str ("resonance_on_shell_limit"), &
	10._default, is_known = .true.)

	model_name = "SM"
	call global%select_model (model_name)
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize simulation object &
	&with resonant subprocesses"
	write (u, "(A)")

	call global%it_list%init ([1], [1000])
	call simulation%init ([procname], &
	integrate=.true., generate=.true., local=global)

	call simulation%write_resonant_subprocess_data (u, 1)

	write (u, "(A)")
	write (u, "(A)") "* Generate event"
	write (u, "(A)")

	call simulation%init_process_selector ()
	call simulation%set_n_events_requested (1)
	call simulation%generate ()

	call eio_out%set_parameters (unit = u, &
	weights = .true., pacify = .true., compressed = .true.)
	call eio_out%init_out (var_str (""))
	call simulation%write_event (eio_out)

	write (u, "(A)")
	write (u, "(A)") "* Write event to separate file &
	&'simulations_15_event_verbose.log'"

	u_verbose = free_unit ()
	open (unit = u_verbose, file = "simulations_15_event_verbose.log", &
	status = "replace", action = "write")
	call simulation%write (u_verbose)
	write (u_verbose, *)
	call simulation%write_event (u_verbose, verbose =.true., testflag = .true.)
	close (u_verbose)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_15"

	end subroutine simulations_15

	@ %def simulations_15
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{More Unit Tests}

	This chapter collects some procedures for testing that can't be
	provided at the point where the corresponding modules are defined,
	because they use other modules of a different level.

	(We should move them back, collecting the high-level functionality in
	init/final hooks that we can set at runtime.)


	\section{Expression Testing}

	Expression objects are part of process and event objects, but the
	process and event object modules should not depend on the
	implementation of expressions. Here, we collect unit tests that
	depend on expression implementation.
	<<[[expr_tests_ut.f90]]>>=
	<<File header>>
	module expr_tests_ut

	use unit_tests
	use expr_tests_uti

	<<Standard module head>>

	<<Expr tests: public test>>

	contains

	<<Expr tests: test driver>>

	end module expr_tests_ut
	@ %def expr_tests_ut
	@
	<<[[expr_tests_uti.f90]]>>=
	<<File header>>

	module expr_tests_uti

	<<Use kinds>>
	<<Use strings>>
	use format_defs, only: FMT_12
	use format_utils, only: write_separator
	use os_interface
	use sm_qcd
	use lorentz
	use ifiles
	use lexers
	use parser
	use model_data
	use interactions, only: reset_interaction_counter
	use process_libraries
	use subevents
	use subevt_expr
	use rng_base
	use mci_base
	use phs_base
	use variables, only: var_list_t
	use eval_trees
	use models
	use prc_core
	use prc_test
	use process, only: process_t
	use instances, only: process_instance_t
	use events

	use rng_base_ut, only: rng_test_factory_t
	use phs_base_ut, only: phs_test_config_t

	<<Standard module head>>

	<<Expr tests: test declarations>>

	contains

	<<Expr tests: tests>>

	<<Expr tests: test auxiliary>>

	end module expr_tests_uti

	@ %def expr_tests_uti
	@
	\subsection{Test}
	This is the master for calling self-test procedures.
	<<Expr tests: public test>>=
	public :: subevt_expr_test
	<<Expr tests: test driver>>=
	subroutine subevt_expr_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Expr tests: execute tests>>
	end subroutine subevt_expr_test

	@ %def subevt_expr_test
	@
	\subsubsection{Parton-event expressions}
	<<Expr tests: execute tests>>=
	call test (subevt_expr_1, "subevt_expr_1", &
	"parton-event expressions", &
	u, results)
	<<Expr tests: test declarations>>=
	public :: subevt_expr_1
	<<Expr tests: tests>>=
	subroutine subevt_expr_1 (u)
	integer, intent(in) :: u
	type(string_t) :: expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: pt_cuts, pt_scale, pt_fac_scale, pt_ren_scale
	type(parse_tree_t) :: pt_weight
	type(parse_node_t), pointer :: pn_cuts, pn_scale, pn_fac_scale, pn_ren_scale
	type(parse_node_t), pointer :: pn_weight
	type(eval_tree_factory_t) :: expr_factory
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(parton_expr_t), target :: expr
	real(default) :: E, Ex, m
	type(vector4_t), dimension(6) :: p
	integer :: i, pdg
	logical :: passed
	real(default) :: scale, weight
	real(default), allocatable :: fac_scale, ren_scale

	write (u, "(A)") "* Test output: subevt_expr_1"
	write (u, "(A)") "* Purpose: Set up a subevt and associated &
	&process-specific expressions"
	write (u, "(A)")

	call syntax_pexpr_init ()

	call syntax_model_file_init ()
	call os_data%init ()
	call model%read (var_str ("Test.mdl"), os_data)

	write (u, "(A)") "* Expression texts"
	write (u, "(A)")


	expr_text = "all Pt > 100 [s]"
	write (u, "(A,A)") "cuts = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (pt_cuts, stream, .true.)
	call stream_final (stream)
	pn_cuts => pt_cuts%get_root_ptr ()

	expr_text = "sqrts"
	write (u, "(A,A)") "scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_scale, stream, .true.)
	call stream_final (stream)
	pn_scale => pt_scale%get_root_ptr ()

	expr_text = "sqrts_hat"
	write (u, "(A,A)") "fac_scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_fac_scale, stream, .true.)
	call stream_final (stream)
	pn_fac_scale => pt_fac_scale%get_root_ptr ()

	expr_text = "100"
	write (u, "(A,A)") "ren_scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_ren_scale, stream, .true.)
	call stream_final (stream)
	pn_ren_scale => pt_ren_scale%get_root_ptr ()

	expr_text = "n_tot - n_in - n_out"
	write (u, "(A,A)") "weight = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_weight, stream, .true.)
	call stream_final (stream)
	pn_weight => pt_weight%get_root_ptr ()

	call ifile_final (ifile)

	write (u, "(A)")
	write (u, "(A)") "* Initialize process expr"
	write (u, "(A)")

	call expr%setup_vars (1000._default)
	call expr%var_list%append_real (var_str ("tolerance"), 0._default)
	call expr%link_var_list (model%get_var_list_ptr ())

	call expr_factory%init (pn_cuts)
	call expr%setup_selection (expr_factory)
	call expr_factory%init (pn_scale)
	call expr%setup_scale (expr_factory)
	call expr_factory%init (pn_fac_scale)
	call expr%setup_fac_scale (expr_factory)
	call expr_factory%init (pn_ren_scale)
	call expr%setup_ren_scale (expr_factory)
	call expr_factory%init (pn_weight)
	call expr%setup_weight (expr_factory)

	call write_separator (u)
	call expr%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill subevt and evaluate expressions"
	write (u, "(A)")

	call subevt_init (expr%subevt_t, 6)
	E = 500._default
	Ex = 400._default
	m = 125._default
	pdg = 25
	p(1) = vector4_moving (E, sqrt (E2 - m2), 3)
	p(2) = vector4_moving (E, -sqrt (E2 - m2), 3)
	p(3) = vector4_moving (Ex, sqrt (Ex2 - m2), 3)
	p(4) = vector4_moving (Ex, -sqrt (Ex2 - m2), 3)
	p(5) = vector4_moving (Ex, sqrt (Ex2 - m2), 1)
	p(6) = vector4_moving (Ex, -sqrt (Ex2 - m2), 1)

	call expr%reset_contents ()
	do i = 1, 2
	call expr%set_beam (i, pdg, p(i), m**2)
	end do
	do i = 3, 4
	call expr%set_incoming (i, pdg, p(i), m**2)
	end do
	do i = 5, 6
	call expr%set_outgoing (i, pdg, p(i), m**2)
	end do
	expr%sqrts_hat = expr%get_sqrts_hat ()
	expr%n_in = 2
	expr%n_out = 2
	expr%n_tot = 4
	expr%subevt_filled = .true.

	call expr%evaluate (passed, scale, fac_scale, ren_scale, weight)

	write (u, "(A,L1)") "Event has passed = ", passed
	write (u, "(A," // FMT_12 // ")") "Scale = ", scale
	write (u, "(A," // FMT_12 // ")") "Factorization scale = ", fac_scale
	write (u, "(A," // FMT_12 // ")") "Renormalization scale = ", ren_scale
	write (u, "(A," // FMT_12 // ")") "Weight = ", weight
	write (u, "(A)")

	call write_separator (u)
	call expr%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call expr%final ()

	call model%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: subevt_expr_1"

	end subroutine subevt_expr_1

	@ %def subevt_expr_1
	@
	\subsubsection{Parton-event expressions}
	<<Expr tests: execute tests>>=
	call test (subevt_expr_2, "subevt_expr_2", &
	"parton-event expressions", &
	u, results)
	<<Expr tests: test declarations>>=
	public :: subevt_expr_2
	<<Expr tests: tests>>=
	subroutine subevt_expr_2 (u)
	integer, intent(in) :: u
	type(string_t) :: expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: pt_selection
	type(parse_tree_t) :: pt_reweight, pt_analysis
	type(parse_node_t), pointer :: pn_selection
	type(parse_node_t), pointer :: pn_reweight, pn_analysis
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(eval_tree_factory_t) :: expr_factory
	type(event_expr_t), target :: expr
	real(default) :: E, Ex, m
	type(vector4_t), dimension(6) :: p
	integer :: i, pdg
	logical :: passed
	real(default) :: reweight
	logical :: analysis_flag

	write (u, "(A)") "* Test output: subevt_expr_2"
	write (u, "(A)") "* Purpose: Set up a subevt and associated &
	&process-specific expressions"
	write (u, "(A)")

	call syntax_pexpr_init ()

	call syntax_model_file_init ()
	call os_data%init ()
	call model%read (var_str ("Test.mdl"), os_data)

	write (u, "(A)") "* Expression texts"
	write (u, "(A)")


	expr_text = "all Pt > 100 [s]"
	write (u, "(A,A)") "selection = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (pt_selection, stream, .true.)
	call stream_final (stream)
	pn_selection => pt_selection%get_root_ptr ()

	expr_text = "n_tot - n_in - n_out"
	write (u, "(A,A)") "reweight = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_reweight, stream, .true.)
	call stream_final (stream)
	pn_reweight => pt_reweight%get_root_ptr ()

	expr_text = "true"
	write (u, "(A,A)") "analysis = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (pt_analysis, stream, .true.)
	call stream_final (stream)
	pn_analysis => pt_analysis%get_root_ptr ()

	call ifile_final (ifile)

	write (u, "(A)")
	write (u, "(A)") "* Initialize process expr"
	write (u, "(A)")

	call expr%setup_vars (1000._default)
	call expr%link_var_list (model%get_var_list_ptr ())
	call expr%var_list%append_real (var_str ("tolerance"), 0._default)

	call expr_factory%init (pn_selection)
	call expr%setup_selection (expr_factory)
	call expr_factory%init (pn_analysis)
	call expr%setup_analysis (expr_factory)
	call expr_factory%init (pn_reweight)
	call expr%setup_reweight (expr_factory)

	call write_separator (u)
	call expr%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill subevt and evaluate expressions"
	write (u, "(A)")

	call subevt_init (expr%subevt_t, 6)
	E = 500._default
	Ex = 400._default
	m = 125._default
	pdg = 25
	p(1) = vector4_moving (E, sqrt (E2 - m2), 3)
	p(2) = vector4_moving (E, -sqrt (E2 - m2), 3)
	p(3) = vector4_moving (Ex, sqrt (Ex2 - m2), 3)
	p(4) = vector4_moving (Ex, -sqrt (Ex2 - m2), 3)
	p(5) = vector4_moving (Ex, sqrt (Ex2 - m2), 1)
	p(6) = vector4_moving (Ex, -sqrt (Ex2 - m2), 1)

	call expr%reset_contents ()
	do i = 1, 2
	call expr%set_beam (i, pdg, p(i), m**2)
	end do
	do i = 3, 4
	call expr%set_incoming (i, pdg, p(i), m**2)
	end do
	do i = 5, 6
	call expr%set_outgoing (i, pdg, p(i), m**2)
	end do
	expr%sqrts_hat = expr%get_sqrts_hat ()
	expr%n_in = 2
	expr%n_out = 2
	expr%n_tot = 4
	expr%subevt_filled = .true.

	call expr%evaluate (passed, reweight, analysis_flag)

	write (u, "(A,L1)") "Event has passed = ", passed
	write (u, "(A," // FMT_12 // ")") "Reweighting factor = ", reweight
	write (u, "(A,L1)") "Analysis flag = ", analysis_flag
	write (u, "(A)")

	call write_separator (u)
	call expr%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call expr%final ()

	call model%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: subevt_expr_2"

	end subroutine subevt_expr_2

	@ %def subevt_expr_2
	@
	\subsubsection{Processes: handle partonic cuts}
	Initialize a process and process instance, choose a sampling point and
	fill the process instance, evaluating a given cut configuration.

	We use the same trivial process as for the previous test. All
	momentum and state dependence is trivial, so we just test basic
	functionality.
	<<Expr tests: execute tests>>=
	call test (processes_5, "processes_5", &
	"handle cuts (partonic event)", &
	u, results)
	<<Expr tests: test declarations>>=
	public :: processes_5
	<<Expr tests: tests>>=
	subroutine processes_5 (u)
	integer, intent(in) :: u
	type(string_t) :: cut_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree
	type(eval_tree_factory_t) :: expr_factory
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), pointer :: model_tmp
	type(model_t), pointer :: model
	type(var_list_t), target :: var_list
	type(process_t), allocatable, target :: process
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_instance_t), allocatable, target :: process_instance

	write (u, "(A)") "* Test output: processes_5"
	write (u, "(A)") "* Purpose: create a process &
	&and fill a process instance"
	write (u, "(A)")

	write (u, "(A)") "* Prepare a cut expression"
	write (u, "(A)")

	call syntax_pexpr_init ()
	cut_expr_text = "all Pt > 100 [s]"
	call ifile_append (ifile, cut_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (parse_tree, stream, .true.)

	write (u, "(A)") "* Build and initialize a test process"
	write (u, "(A)")

	libname = "processes5"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)

	call syntax_model_file_init ()
	allocate (model_tmp)
	call model_tmp%read (var_str ("Test.mdl"), os_data)
	call var_list%init_snapshot (model_tmp%get_var_list_ptr ())
	model => model_tmp

	call reset_interaction_counter ()

	call var_list%append_real (var_str ("tolerance"), 0._default)
	call var_list%append_log (var_str ("?alphas_is_fixed"), .true.)
	call var_list%append_int (var_str ("seed"), 0)

	allocate (process)
	call process%init (procname, lib, os_data, model, var_list)

	call var_list%final ()

	allocate (phs_test_config_t :: phs_config_template)
	call process%setup_test_cores ()
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Prepare a trivial beam setup"
	write (u, "(A)")

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()
	call process%setup_mci (dispatch_mci_empty)

	write (u, "(A)") "* Complete process initialization and set cuts"
	write (u, "(A)")

	call process%setup_terms ()
	call expr_factory%init (parse_tree%get_root_ptr ())
	call process%set_cuts (expr_factory)
	call process%write (.false., u, &
	show_var_list=.true., show_expressions=.true., show_os_data=.false.)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance"
	write (u, "(A)")

	allocate (process_instance)
	call process_instance%init (process)

	write (u, "(A)")
	write (u, "(A)") "* Inject a set of random numbers"
	write (u, "(A)")

	call process_instance%choose_mci (1)
	call process_instance%set_mcpar ([0._default, 0._default])

	write (u, "(A)")
	write (u, "(A)") "* Set up kinematics and subevt, check cuts (should fail)"
	write (u, "(A)")

	call process_instance%select_channel (1)
	call process_instance%compute_seed_kinematics ()
	call process_instance%compute_hard_kinematics ()
	call process_instance%compute_eff_kinematics ()
	call process_instance%evaluate_expressions ()
	call process_instance%compute_other_channels ()

	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for another set (should succeed)"
	write (u, "(A)")

	call process_instance%reset ()
	call process_instance%set_mcpar ([0.5_default, 0.125_default])
	call process_instance%select_channel (1)
	call process_instance%compute_seed_kinematics ()
	call process_instance%compute_hard_kinematics ()
	call process_instance%compute_eff_kinematics ()
	call process_instance%evaluate_expressions ()
	call process_instance%compute_other_channels ()
	call process_instance%evaluate_trace ()

	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for another set using convenience procedure &
	&(failure)"
	write (u, "(A)")

	call process_instance%evaluate_sqme (1, [0.0_default, 0.2_default])

	call process_instance%write_header (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for another set using convenience procedure &
	&(success)"
	write (u, "(A)")

	call process_instance%evaluate_sqme (1, [0.1_default, 0.2_default])

	call process_instance%write_header (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call parse_tree_final (parse_tree)
	call stream_final (stream)
	call ifile_final (ifile)
	call syntax_pexpr_final ()

	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_5"

	end subroutine processes_5

	@ %def processes_5
	@ Trivial for testing: do not allocate the MCI record.
	<<Expr tests: test auxiliary>>=
	subroutine dispatch_mci_empty (mci, var_list, process_id, is_nlo)
	class(mci_t), allocatable, intent(out) :: mci
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_id
	logical, intent(in), optional :: is_nlo
	end subroutine dispatch_mci_empty

	@ %def dispatch_mci_empty
	@
	\subsubsection{Processes: scales and such}
	Initialize a process and process instance, choose a sampling point and
	fill the process instance, evaluating a given cut configuration.

	We use the same trivial process as for the previous test. All
	momentum and state dependence is trivial, so we just test basic
	functionality.
	<<Expr tests: execute tests>>=
	call test (processes_6, "processes_6", &
	"handle scales and weight (partonic event)", &
	u, results)
	<<Expr tests: test declarations>>=
	public :: processes_6
	<<Expr tests: tests>>=
	subroutine processes_6 (u)
	integer, intent(in) :: u
	type(string_t) :: expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: pt_scale, pt_fac_scale, pt_ren_scale, pt_weight
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(os_data_t) :: os_data
	type(model_t), pointer :: model_tmp
	type(model_t), pointer :: model
	type(var_list_t), target :: var_list
	type(process_t), allocatable, target :: process
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_instance_t), allocatable, target :: process_instance
	type(eval_tree_factory_t) :: expr_factory

	write (u, "(A)") "* Test output: processes_6"
	write (u, "(A)") "* Purpose: create a process &
	&and fill a process instance"
	write (u, "(A)")

	write (u, "(A)") "* Prepare expressions"
	write (u, "(A)")

	call syntax_pexpr_init ()

	expr_text = "sqrts - 100 GeV"
	write (u, "(A,A)") "scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_scale, stream, .true.)
	call stream_final (stream)

	expr_text = "sqrts_hat"
	write (u, "(A,A)") "fac_scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_fac_scale, stream, .true.)
	call stream_final (stream)

	expr_text = "eval sqrt (M2) [collect [s]]"
	write (u, "(A,A)") "ren_scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_ren_scale, stream, .true.)
	call stream_final (stream)

	expr_text = "n_tot * n_in * n_out * (eval Phi / pi [s])"
	write (u, "(A,A)") "weight = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_weight, stream, .true.)
	call stream_final (stream)

	call ifile_final (ifile)

	write (u, "(A)")
	write (u, "(A)") "* Build and initialize a test process"
	write (u, "(A)")

	libname = "processes4"
	procname = libname

	call os_data%init ()
	call prc_test_create_library (libname, lib)

	call syntax_model_file_init ()
	allocate (model_tmp)
	call model_tmp%read (var_str ("Test.mdl"), os_data)
	call var_list%init_snapshot (model_tmp%get_var_list_ptr ())
	model => model_tmp

	call var_list%append_log (var_str ("?alphas_is_fixed"), .true.)
	call var_list%append_int (var_str ("seed"), 0)

	call reset_interaction_counter ()

	allocate (process)
	call process%init (procname, lib, os_data, model, var_list)

	call var_list%final ()

	call process%setup_test_cores ()
	allocate (phs_test_config_t :: phs_config_template)
	call process%init_components (phs_config_template)

	write (u, "(A)") "* Prepare a trivial beam setup"
	write (u, "(A)")

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()
	call process%setup_mci (dispatch_mci_empty)

	write (u, "(A)") "* Complete process initialization and set cuts"
	write (u, "(A)")

	call process%setup_terms ()
	call expr_factory%init (pt_scale%get_root_ptr ())
	call process%set_scale (expr_factory)
	call expr_factory%init (pt_fac_scale%get_root_ptr ())
	call process%set_fac_scale (expr_factory)
	call expr_factory%init (pt_ren_scale%get_root_ptr ())
	call process%set_ren_scale (expr_factory)
	call expr_factory%init (pt_weight%get_root_ptr ())
	call process%set_weight (expr_factory)
	call process%write (.false., u, show_expressions=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance and evaluate"
	write (u, "(A)")

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%choose_mci (1)
	call process_instance%evaluate_sqme (1, [0.5_default, 0.125_default])

	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call parse_tree_final (pt_scale)
	call parse_tree_final (pt_fac_scale)
	call parse_tree_final (pt_ren_scale)
	call parse_tree_final (pt_weight)
	call syntax_pexpr_final ()

	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: processes_6"

	end subroutine processes_6

	@ %def processes_6
	@
	\subsubsection{Event expressions}
	After generating an event, fill the [[subevt]] and evaluate expressions for
	selection, reweighting, and analysis.
	<<Expr tests: execute tests>>=
	call test (events_3, "events_3", &
	"expression evaluation", &
	u, results)
	<<Expr tests: test declarations>>=
	public :: events_3
	<<Expr tests: tests>>=
	subroutine events_3 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	type(string_t) :: expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: pt_selection, pt_reweight, pt_analysis
	type(eval_tree_factory_t) :: expr_factory
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(os_data_t) :: os_data
	type(model_t), pointer :: model
	type(var_list_t), target :: var_list

	write (u, "(A)") "* Test output: events_3"
	write (u, "(A)") "* Purpose: generate an event and evaluate expressions"
	write (u, "(A)")

	call syntax_pexpr_init ()

	write (u, "(A)") "* Expression texts"
	write (u, "(A)")

	expr_text = "all Pt > 100 [s]"
	write (u, "(A,A)") "selection = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (pt_selection, stream, .true.)
	call stream_final (stream)

	expr_text = "1 + sqrts_hat / sqrts"
	write (u, "(A,A)") "reweight = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_reweight, stream, .true.)
	call stream_final (stream)

	expr_text = "true"
	write (u, "(A,A)") "analysis = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (pt_analysis, stream, .true.)
	call stream_final (stream)

	call ifile_final (ifile)

	write (u, "(A)")
	write (u, "(A)") "* Initialize test process event"

	call os_data%init ()

	call syntax_model_file_init ()
	allocate (model)
	call model%read (var_str ("Test.mdl"), os_data)
	call var_list%init_snapshot (model%get_var_list_ptr ())

	call var_list%append_log (var_str ("?alphas_is_fixed"), .true.)
	call var_list%append_int (var_str ("seed"), 0)

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model, var_list)

	call var_list%final ()

	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Initialize event object and set expressions"

	allocate (event)
	call event%basic_init ()

	call expr_factory%init (pt_selection%get_root_ptr ())
	call event%set_selection (expr_factory)
	call expr_factory%init (pt_reweight%get_root_ptr ())
	call event%set_reweight (expr_factory)
	call expr_factory%init (pt_analysis%get_root_ptr ())
	call event%set_analysis (expr_factory)

	call event%connect (process_instance, process%get_model_ptr ())
	call event%expr%var_list%append_real (var_str ("tolerance"), 0._default)
	call event%setup_expressions ()

	write (u, "(A)")
	write (u, "(A)") "* Generate test process event"

	call process_instance%generate_weighted_event (1)

	write (u, "(A)")
	write (u, "(A)") "* Fill event object and evaluate expressions"
	write (u, "(A)")

	call event%generate (1, [0.4_default, 0.4_default])
	call event%set_index (42)
	call event%evaluate_expressions ()
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: events_3"

	end subroutine events_3

	@ %def events_3
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Top Level}

	The top level consists of
	\begin{description}
	\item[commands]
	Defines generic command-list and command objects, and all specific
	implementations. Each command type provides a specific
	functionality. Together with the modules that provide expressions
	and variables, this module defines the Sindarin language.
	\item[whizard]
	This module interprets streams of various kind in terms of the
	command language. It also contains the unit-test feature. We also
	define the externally visible procedures here, for the \whizard\ as
	a library.
	\item[main]
	The driver for \whizard\ as a stand-alone program. Contains the
	command-line interpreter.
	\item[whizard\_c\_interface]
	Alternative top-level procedures, for use in the context of a
	C-compatible caller program.
	\end{description}

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Commands}
	This module defines the command language of the main input file.
	<<[[commands.f90]]>>=
	<<File header>>

	module commands

	<<Use kinds>>
	<<Use strings>>
	<<Use debug>>
	use diagnostics
	use lexers
	use syntax_rules
	use parser
	use variables, only: var_list_t, V_NONE, V_LOG, V_INT, V_REAL, V_CMPLX, V_STR, V_PDG
	use eval_trees
	use polarizations
	use rt_data

	<<Standard module head>>

	<<Commands: public>>

	<<Commands: types>>

	<<Commands: variables>>

	<<Commands: parameters>>

	<<Commands: interfaces>>

	interface
	<<Commands: sub interfaces>>
	end interface

	contains

	<<Commands: main procedures>>

	end module commands
	@ %def commands
	@
	<<[[commands_sub.f90]]>>=
	<<File header>>

	submodule (commands) commands_s

	<<Use mpi f08>>
	use io_units
	use string_utils, only: lower_case, split_string, str
	use format_utils, only: write_indent
	use format_defs, only: FMT_14, FMT_19
	use constants, only: one
	use physics_defs
	use sorting
	use sf_lhapdf, only: lhapdf_global_reset
	use os_interface
	use ifiles
	use analysis
	use pdg_arrays
	use observables, only: var_list_check_observable
	use observables, only: var_list_check_result_var
	use models
	use auto_components
	use flavors
	use particle_specifiers
	use process_libraries
	use process
	use instances
	use prclib_stacks
	use slha_interface
	use user_files
	use eio_data
	use process_configurations
	use compilations, only: compile_library, compile_executable
	use integrations, only: integrate_process
	use restricted_subprocesses, only: get_libname_res
	use restricted_subprocesses, only: spawn_resonant_subprocess_libraries
	use event_streams
	use radiation_generator
	use simulations
	!!! Intel oneAPI 2022/23 regression workaround
	use variables, only: var_list_t

	implicit none

	contains

	<<Commands: procedures>>

	end submodule commands_s

	@ %def commands_s
	@
	\subsection{The command type}
	The command type is a generic type that holds any command, compiled
	for execution.

	Each command may come with its own local environment. The command list that
	determines this environment is allocated as [[options]], if necessary. (It
	has to be allocated as a pointer because the type definition is recursive.) The
	local environment is available as a pointer which either points to the global
	environment, or is explicitly allocated and initialized.
	<<Commands: types>>=
	type, abstract :: command_t
	type(parse_node_t), pointer :: pn => null ()
	class(command_t), pointer :: next => null ()
	type(parse_node_t), pointer :: pn_opt => null ()
	type(command_list_t), pointer :: options => null ()
	type(rt_data_t), pointer :: local => null ()
	contains
	<<Commands: command: TBP>>
	end type command_t

	@ %def command_t
	@ Finalizer: If there is an option list, finalize the option list and
	deallocate. If not, the local environment is just a pointer.
	<<Commands: command: TBP>>=
	procedure :: final => command_final
	<<Commands: sub interfaces>>=
	recursive module subroutine command_final (cmd)
	class(command_t), intent(inout) :: cmd
	end subroutine command_final
	<<Commands: procedures>>=
	recursive module subroutine command_final (cmd)
	class(command_t), intent(inout) :: cmd
	if (associated (cmd%options)) then
	call cmd%options%final ()
	deallocate (cmd%options)
	call cmd%local%local_final ()
	deallocate (cmd%local)
	else
	cmd%local => null ()
	end if
	end subroutine command_final

	@ %def command_final
	@ Allocate a command with the appropriate concrete type. Store the
	parse node pointer in the command object, so we can reference to it
	when compiling.
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<Commands: main procedures>>=
	subroutine dispatch_command (command, pn)
	class(command_t), intent(inout), pointer :: command
	type(parse_node_t), intent(in), target :: pn
	select case (char (parse_node_get_rule_key (pn)))
	case ("cmd_model")
	allocate (cmd_model_t :: command)
	case ("cmd_library")
	allocate (cmd_library_t :: command)
	case ("cmd_process")
	allocate (cmd_process_t :: command)
	case ("cmd_nlo")
	allocate (cmd_nlo_t :: command)
	case ("cmd_compile")
	allocate (cmd_compile_t :: command)
	case ("cmd_exec")
	allocate (cmd_exec_t :: command)
	case ("cmd_num", "cmd_complex", "cmd_real", "cmd_int", &
	"cmd_log_decl", "cmd_log", "cmd_string", "cmd_string_decl", &
	"cmd_alias", "cmd_result")
	allocate (cmd_var_t :: command)
	case ("cmd_slha")
	allocate (cmd_slha_t :: command)
	case ("cmd_show")
	allocate (cmd_show_t :: command)
	case ("cmd_clear")
	allocate (cmd_clear_t :: command)
	case ("cmd_expect")
	allocate (cmd_expect_t :: command)
	case ("cmd_beams")
	allocate (cmd_beams_t :: command)
	case ("cmd_beams_pol_density")
	allocate (cmd_beams_pol_density_t :: command)
	case ("cmd_beams_pol_fraction")
	allocate (cmd_beams_pol_fraction_t :: command)
	case ("cmd_beams_momentum")
	allocate (cmd_beams_momentum_t :: command)
	case ("cmd_beams_theta")
	allocate (cmd_beams_theta_t :: command)
	case ("cmd_beams_phi")
	allocate (cmd_beams_phi_t :: command)
	case ("cmd_cuts")
	allocate (cmd_cuts_t :: command)
	case ("cmd_scale")
	allocate (cmd_scale_t :: command)
	case ("cmd_fac_scale")
	allocate (cmd_fac_scale_t :: command)
	case ("cmd_ren_scale")
	allocate (cmd_ren_scale_t :: command)
	case ("cmd_weight")
	allocate (cmd_weight_t :: command)
	case ("cmd_selection")
	allocate (cmd_selection_t :: command)
	case ("cmd_reweight")
	allocate (cmd_reweight_t :: command)
	case ("cmd_iterations")
	allocate (cmd_iterations_t :: command)
	case ("cmd_integrate")
	allocate (cmd_integrate_t :: command)
	case ("cmd_observable")
	allocate (cmd_observable_t :: command)
	case ("cmd_histogram")
	allocate (cmd_histogram_t :: command)
	case ("cmd_plot")
	allocate (cmd_plot_t :: command)
	case ("cmd_graph")
	allocate (cmd_graph_t :: command)
	case ("cmd_record")
	allocate (cmd_record_t :: command)
	case ("cmd_analysis")
	allocate (cmd_analysis_t :: command)
	case ("cmd_alt_setup")
	allocate (cmd_alt_setup_t :: command)
	case ("cmd_unstable")
	allocate (cmd_unstable_t :: command)
	case ("cmd_stable")
	allocate (cmd_stable_t :: command)
	case ("cmd_polarized")
	allocate (cmd_polarized_t :: command)
	case ("cmd_unpolarized")
	allocate (cmd_unpolarized_t :: command)
	case ("cmd_sample_format")
	allocate (cmd_sample_format_t :: command)
	case ("cmd_simulate")
	allocate (cmd_simulate_t :: command)
	case ("cmd_rescan")
	allocate (cmd_rescan_t :: command)
	case ("cmd_write_analysis")
	allocate (cmd_write_analysis_t :: command)
	case ("cmd_compile_analysis")
	allocate (cmd_compile_analysis_t :: command)
	case ("cmd_open_out")
	allocate (cmd_open_out_t :: command)
	case ("cmd_close_out")
	allocate (cmd_close_out_t :: command)
	case ("cmd_printf")
	allocate (cmd_printf_t :: command)
	case ("cmd_scan")
	allocate (cmd_scan_t :: command)
	case ("cmd_if")
	allocate (cmd_if_t :: command)
	case ("cmd_include")
	allocate (cmd_include_t :: command)
	case ("cmd_export")
	allocate (cmd_export_t :: command)
	case ("cmd_quit")
	allocate (cmd_quit_t :: command)
	case default
	print *, char (parse_node_get_rule_key (pn))
	call msg_bug ("Command not implemented")
	end select
	command%pn => pn
	end subroutine dispatch_command

	@ %def dispatch_command
	@ Output. We allow for indentation so we can display a command tree.
	<<Commands: command: TBP>>=
	procedure (command_write), deferred :: write
	<<Commands: interfaces>>=
	abstract interface
	subroutine command_write (cmd, unit, indent)
	import
	class(command_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine command_write
	end interface

	@ %def command_write
	@ Compile a command. The command type is already fixed, so this is a
	deferred type-bound procedure.
	<<Commands: command: TBP>>=
	procedure (command_compile), deferred :: compile
	<<Commands: interfaces>>=
	abstract interface
	subroutine command_compile (cmd, global)
	import
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine command_compile
	end interface

	@ %def command_compile
	@ Execute a command. This will use and/or modify the runtime data
	set. If the [[quit]] flag is set, the caller should terminate command
	execution.
	<<Commands: command: TBP>>=
	procedure (command_execute), deferred :: execute
	<<Commands: interfaces>>=
	abstract interface
	subroutine command_execute (cmd, global)
	import
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine command_execute
	end interface

	@ %def command_execute
	@
	\subsection{Options}
	The [[options]] command list is allocated, initialized, and executed, if the
	command is associated with an option text in curly braces. If present, a
	separate local runtime data set [[local]] will be allocated and initialized;
	otherwise, [[local]] becomes a pointer to the global dataset.

	For output, we indent the options list.
	<<Commands: command: TBP>>=
	procedure :: write_options => command_write_options
	<<Commands: sub interfaces>>=
	recursive module subroutine command_write_options (cmd, unit, indent)
	class(command_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine command_write_options
	<<Commands: procedures>>=
	recursive module subroutine command_write_options (cmd, unit, indent)
	class(command_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: ind
	ind = 1; if (present (indent)) ind = indent + 1
	if (associated (cmd%options)) call cmd%options%write (unit, ind)
	end subroutine command_write_options

	@ %def command_write_options
	@ Compile the options list, if any. This implies initialization of the local
	environment. Should be done once the [[pn_opt]] node has been assigned (if
	applicable), but before the actual command compilation.
	<<Commands: command: TBP>>=
	procedure :: compile_options => command_compile_options
	<<Commands: sub interfaces>>=
	recursive module subroutine command_compile_options (cmd, global)
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine command_compile_options
	<<Commands: procedures>>=
	recursive module subroutine command_compile_options (cmd, global)
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (associated (cmd%pn_opt)) then
	allocate (cmd%local)
	call cmd%local%local_init (global)
	call global%copy_globals (cmd%local)
	allocate (cmd%options)
	call cmd%options%compile (cmd%pn_opt, cmd%local)
	call global%restore_globals (cmd%local)
	call cmd%local%deactivate ()
	else
	cmd%local => global
	end if
	end subroutine command_compile_options

	@ %def command_compile_options
	@ Execute options. First prepare the local environment, then execute the
	command list.
	<<Commands: command: TBP>>=
	procedure :: execute_options => cmd_execute_options
	<<Commands: sub interfaces>>=
	recursive module subroutine cmd_execute_options (cmd, global)
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_execute_options
	<<Commands: procedures>>=
	recursive module subroutine cmd_execute_options (cmd, global)
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (associated (cmd%options)) then
	call cmd%local%activate ()
	call cmd%options%execute (cmd%local)
	end if
	end subroutine cmd_execute_options

	@ %def cmd_execute_options
	@ This must be called after the parent command has been executed, to undo
	temporary modifications to the environment. Note that some modifications to
	[[global]] can become permanent.
	<<Commands: command: TBP>>=
	procedure :: reset_options => cmd_reset_options
	<<Commands: sub interfaces>>=
	module subroutine cmd_reset_options (cmd, global)
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_reset_options
	<<Commands: procedures>>=
	module subroutine cmd_reset_options (cmd, global)
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (associated (cmd%options)) then
	call cmd%local%deactivate (global)
	end if
	end subroutine cmd_reset_options

	@ %def cmd_reset_options
	@
	\subsection{Specific command types}
	\subsubsection{Model configuration}
	The command declares a model, looks for the specified file and loads
	it.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_model_t
	private
	type(string_t) :: name
	type(string_t) :: scheme
	logical :: ufo_model = .false.
	logical :: ufo_path_set = .false.
	type(string_t) :: ufo_path
	contains
	<<Commands: cmd model: TBP>>
	end type cmd_model_t

	@ %def cmd_model_t
	@ Output
	<<Commands: cmd model: TBP>>=
	procedure :: write => cmd_model_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_model_write (cmd, unit, indent)
	class(cmd_model_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_model_write
	<<Commands: procedures>>=
	module subroutine cmd_model_write (cmd, unit, indent)
	class(cmd_model_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,'""',A,'""')", advance="no") "model =", char (cmd%name)
	if (cmd%ufo_model) then
	if (cmd%ufo_path_set) then
	write (u, "(1x,A,A,A)") "(ufo (", char (cmd%ufo_path), "))"
	else
	write (u, "(1x,A)") "(ufo)"
	end if
	else if (cmd%scheme /= "") then
	write (u, "(1x,'(',A,')')") char (cmd%scheme)
	else
	write (u, *)
	end if
	end subroutine cmd_model_write

	@ %def cmd_model_write
	@ Compile. Get the model name and read the model from file, so it is
	readily available when the command list is executed. If the model has a
	scheme argument, take this into account.

	Assign the model pointer in the [[global]] record, so it can be used for
	(read-only) variable lookup while compiling further commands.
	<<Commands: cmd model: TBP>>=
	procedure :: compile => cmd_model_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_model_compile (cmd, global)
	class(cmd_model_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_model_compile
	<<Commands: procedures>>=
	module subroutine cmd_model_compile (cmd, global)
	class(cmd_model_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_name, pn_arg, pn_scheme
	type(parse_node_t), pointer :: pn_ufo_arg, pn_path
	type(model_t), pointer :: model
	type(string_t) :: scheme
	pn_name => cmd%pn%get_sub_ptr (3)
	pn_arg => pn_name%get_next_ptr ()
	if (associated (pn_arg)) then
	pn_scheme => pn_arg%get_sub_ptr ()
	else
	pn_scheme => null ()
	end if
	cmd%name = pn_name%get_string ()
	if (associated (pn_scheme)) then
	select case (char (pn_scheme%get_rule_key ()))
	case ("ufo_spec")
	cmd%ufo_model = .true.
	pn_ufo_arg => pn_scheme%get_sub_ptr (2)
	if (associated (pn_ufo_arg)) then
	pn_path => pn_ufo_arg%get_sub_ptr ()
	cmd%ufo_path_set = .true.
	cmd%ufo_path = pn_path%get_string ()
	end if
	case default
	scheme = pn_scheme%get_string ()
	select case (char (lower_case (scheme)))
	case ("ufo"); cmd%ufo_model = .true.
	case default; cmd%scheme = scheme
	end select
	end select
	if (cmd%ufo_model) then
	if (cmd%ufo_path_set) then
	call preload_ufo_model (model, cmd%name, cmd%ufo_path)
	else
	call preload_ufo_model (model, cmd%name)
	end if
	else
	call preload_model (model, cmd%name, cmd%scheme)
	end if
	else
	cmd%scheme = ""
	call preload_model (model, cmd%name)
	end if
	global%model => model
	if (associated (global%model)) then
	call global%model%link_var_list (global%var_list)
	end if
	contains
	subroutine preload_model (model, name, scheme)
	type(model_t), pointer, intent(out) :: model
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	model => null ()
	if (associated (global%model)) then
	if (global%model%matches (name, scheme)) then
	model => global%model
	end if
	end if
	if (.not. associated (model)) then
	if (global%model_list%model_exists (name, scheme)) then
	model => global%model_list%get_model_ptr (name, scheme)
	else
	call global%read_model (name, model, scheme)
	end if
	end if
	end subroutine preload_model
	subroutine preload_ufo_model (model, name, ufo_path)
	type(model_t), pointer, intent(out) :: model
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: ufo_path
	model => null ()
	if (associated (global%model)) then
	if (global%model%matches (name, ufo=.true., ufo_path=ufo_path)) then
	model => global%model
	end if
	end if
	if (.not. associated (model)) then
	if (global%model_list%model_exists (name, &
	ufo=.true., ufo_path=ufo_path)) then
	model => global%model_list%get_model_ptr (name, &
	ufo=.true., ufo_path=ufo_path)
	else
	call global%read_ufo_model (name, model, ufo_path=ufo_path)
	end if
	end if
	end subroutine preload_ufo_model
	end subroutine cmd_model_compile

	@ %def cmd_model_compile
	@ Execute: Insert a pointer into the global data record and reassign
	the variable list.
	<<Commands: cmd model: TBP>>=
	procedure :: execute => cmd_model_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_model_execute (cmd, global)
	class(cmd_model_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_model_execute
	<<Commands: procedures>>=
	module subroutine cmd_model_execute (cmd, global)
	class(cmd_model_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (cmd%ufo_model) then
	if (cmd%ufo_path_set) then
	call global%select_model (cmd%name, ufo=.true., ufo_path=cmd%ufo_path)
	else
	call global%select_model (cmd%name, ufo=.true.)
	end if
	else if (cmd%scheme /= "") then
	call global%select_model (cmd%name, cmd%scheme)
	else
	call global%select_model (cmd%name)
	end if
	if (.not. associated (global%model)) &
	call msg_fatal ("Switching to model '" &
	// char (cmd%name) // "': model not found")
	end subroutine cmd_model_execute

	@ %def cmd_model_execute
	@
	\subsubsection{Library configuration}
	We configure a process library that should hold the subsequently
	defined processes. If the referenced library exists already, just
	make it the currently active one.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_library_t
	private
	type(string_t) :: name
	contains
	<<Commands: cmd library: TBP>>
	end type cmd_library_t

	@ %def cmd_library_t
	@ Output.
	<<Commands: cmd library: TBP>>=
	procedure :: write => cmd_library_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_library_write (cmd, unit, indent)
	class(cmd_library_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_library_write
	<<Commands: procedures>>=
	module subroutine cmd_library_write (cmd, unit, indent)
	class(cmd_library_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit)
	call write_indent (u, indent)
	write (u, "(1x,A,1x,'""',A,'""')") "library =", char (cmd%name)
	end subroutine cmd_library_write

	@ %def cmd_library_write
	@ Compile. Get the library name.
	<<Commands: cmd library: TBP>>=
	procedure :: compile => cmd_library_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_library_compile (cmd, global)
	class(cmd_library_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_library_compile
	<<Commands: procedures>>=
	module subroutine cmd_library_compile (cmd, global)
	class(cmd_library_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_name
	pn_name => parse_node_get_sub_ptr (cmd%pn, 3)
	cmd%name = parse_node_get_string (pn_name)
	end subroutine cmd_library_compile

	@ %def cmd_library_compile
	@ Execute: Initialize a new library and push it on the library stack
	(if it does not yet exist). Insert a pointer to the library into the
	global data record. Then, try to load the library unless the
	[[rebuild]] flag is set.
	<<Commands: cmd library: TBP>>=
	procedure :: execute => cmd_library_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_library_execute (cmd, global)
	class(cmd_library_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_library_execute
	<<Commands: procedures>>=
	module subroutine cmd_library_execute (cmd, global)
	class(cmd_library_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	logical :: rebuild_library
	lib => global%prclib_stack%get_library_ptr (cmd%name)
	rebuild_library = &
	global%var_list%get_lval (var_str ("?rebuild_library"))
	if (.not. (associated (lib))) then
	allocate (lib_entry)
	call lib_entry%init (cmd%name)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)
	else
	call global%update_prclib (lib)
	end if
	if (associated (lib) .and. .not. rebuild_library) then
	call lib%update_status (global%os_data)
	end if
	end subroutine cmd_library_execute

	@ %def cmd_library_execute
	@
	\subsubsection{Process configuration}
	We define a process-configuration command as a specific type. The
	incoming and outgoing particles are given evaluation-trees which we
	transform to PDG-code arrays. For transferring to \oMega, they are
	reconverted to strings.

	For the incoming particles, we store parse nodes individually. We do
	not yet resolve the outgoing state, so we store just a single parse
	node.

	This also includes the choice of method for the corresponding process:
	[[omega]] for \oMega\ matrix elements as Fortran code, [[ovm]] for
	\oMega\ matrix elements as a bytecode virtual machine, [[test]] for
	special processes, [[unit_test]] for internal test matrix elements
	generated by \whizard, [[template]] and [[template_unity]] for test
	matrix elements generated by \whizard\ as Fortran code similar to the
	\oMega\ code. If the one-loop program (OLP) \gosam\ is linked, also
	matrix elements from there (at leading and next-to-leading order) can
	be generated via [[gosam]].
	<<Commands: types>>=
	type, extends (command_t) :: cmd_process_t
	private
	type(string_t) :: id
	integer :: n_in = 0
	type(parse_node_p), dimension(:), allocatable :: pn_pdg_in
	type(parse_node_t), pointer :: pn_out => null ()
	contains
	<<Commands: cmd process: TBP>>
	end type cmd_process_t

	@ %def cmd_process_t
	@ Output. The particle expressions are not resolved, so we just list the
	number of incoming particles.
	<<Commands: cmd process: TBP>>=
	procedure :: write => cmd_process_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_process_write (cmd, unit, indent)
	class(cmd_process_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_process_write
	<<Commands: procedures>>=
	module subroutine cmd_process_write (cmd, unit, indent)
	class(cmd_process_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A,A,I0,A)") "process: ", char (cmd%id), " (", &
	size (cmd%pn_pdg_in), " -> X)"
	call cmd%write_options (u, indent)
	end subroutine cmd_process_write

	@ %def cmd_process_write
	@ Compile. Find and assign the parse nodes.
	<<Commands: cmd process: TBP>>=
	procedure :: compile => cmd_process_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_process_compile (cmd, global)
	class(cmd_process_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_process_compile
	<<Commands: procedures>>=
	module subroutine cmd_process_compile (cmd, global)
	class(cmd_process_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_id, pn_in, pn_codes
	integer :: i
	pn_id => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_in => parse_node_get_next_ptr (pn_id, 2)
	cmd%pn_out => parse_node_get_next_ptr (pn_in, 2)
	cmd%pn_opt => parse_node_get_next_ptr (cmd%pn_out)
	call cmd%compile_options (global)
	cmd%id = parse_node_get_string (pn_id)
	cmd%n_in = parse_node_get_n_sub (pn_in)
	pn_codes => parse_node_get_sub_ptr (pn_in)
	allocate (cmd%pn_pdg_in (cmd%n_in))
	do i = 1, cmd%n_in
	cmd%pn_pdg_in(i)%ptr => pn_codes
	pn_codes => parse_node_get_next_ptr (pn_codes)
	end do
	end subroutine cmd_process_compile

	@ %def cmd_process_compile
	@ Command execution. Evaluate the subevents, transform PDG codes
	into strings, and add the current process configuration to the
	process library.

	The initial state will be unique (one or two particles). For the final state,
	we allow for expressions. The expressions will be expanded until we have a
	sum of final states. Each distinct final state will get its own process
	component.

	To identify equivalent final states, we transform the final state into
	an array of PDG codes, which we sort and compare. If a particle entry
	is actually a PDG array, only the first entry in the array is used for
	the comparison. The user should make sure that there is no overlap
	between different particles or arrays which would make the expansion
	ambiguous.

	There are two possibilities that a process contains more than one
	component: by an explicit component statement by the user for
	inclusive processes, or by having one process at NLO level. The first
	option is determined in the chunk [[scan components]], and
	determines [[n_components]].
	<<Commands: cmd process: TBP>>=
	procedure :: execute => cmd_process_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_process_execute (cmd, global)
	class(cmd_process_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_process_execute
	<<Commands: procedures>>=
	module subroutine cmd_process_execute (cmd, global)
	class(cmd_process_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(pdg_array_t) :: pdg_in, pdg_out
	type(pdg_array_t), dimension(:), allocatable :: pdg_out_tab
	type(string_t), dimension(:), allocatable :: prt_in
	type(string_t) :: prt_out, prt_out1
	type(process_configuration_t) :: prc_config
	type(prt_expr_t) :: prt_expr_out
	type(prt_spec_t), dimension(:), allocatable :: prt_spec_in
	type(prt_spec_t), dimension(:), allocatable :: prt_spec_out
	type(var_list_t), pointer :: var_list
	integer, dimension(:), allocatable :: ipdg
	integer, dimension(:), allocatable :: i_term
	integer, dimension(:), allocatable :: nlo_comp
	integer :: i, j, n_in, n_out, n_terms, n_components
	logical :: nlo_fixed_order
	logical :: qcd_corr, qed_corr
	type(string_t), dimension(:), allocatable :: prt_in_nlo, prt_out_nlo
	type(radiation_generator_t) :: radiation_generator
	type(pdg_list_t) :: pl_in, pl_out, pl_excluded_gauge_splittings
	type(string_t) :: method, born_me_method, loop_me_method, &
	correlation_me_method, real_tree_me_method, dglap_me_method
	integer, dimension(:), allocatable :: i_list
	logical :: use_real_finite
	logical :: gks_active
	logical :: initial_state_colored
	logical :: neg_sf
	integer :: comp_mult
	integer :: gks_multiplicity
	integer :: n_components_init
	integer :: alpha_power, alphas_power
	logical :: requires_soft_mismatch, requires_dglap_remnants
	type(string_t) :: nlo_correction_type
	type(pdg_array_t), dimension(:), allocatable :: pdg
	if (debug_on) call msg_debug (D_CORE, "cmd_process_execute")
	var_list => cmd%local%get_var_list_ptr ()

	n_in = size (cmd%pn_pdg_in)
	allocate (prt_in (n_in), prt_spec_in (n_in))
	do i = 1, n_in
	pdg_in = &
	eval_pdg_array (cmd%pn_pdg_in(i)%ptr, var_list)
	prt_in(i) = make_flavor_string (pdg_in, cmd%local%model)
	prt_spec_in(i) = new_prt_spec (prt_in(i))
	end do
	call compile_prt_expr &
	(prt_expr_out, cmd%pn_out, var_list, cmd%local%model)
	call prt_expr_out%expand ()
	<<Commands: cmd process execute: scan components>>
	allocate (nlo_comp (n_components))

	nlo_fixed_order = cmd%local%nlo_fixed_order
	gks_multiplicity = var_list%get_ival (var_str ("gks_multiplicity"))
	gks_active = gks_multiplicity > 2
	neg_sf = .false.
	select case (char (var_list%get_sval (var_str ("$negative_sf"))))
	case ("default")
	neg_sf = nlo_fixed_order
	case ("negative")
	neg_sf = .true.
	case ("positive")
	neg_sf = .false.
	case default
	call msg_fatal ("Negative PDF handling can only be " // &
	"default, negative or positive.")
	end select
	<<Commands: cmd process execute: check for nlo corrections>>

	method = var_list%get_sval (var_str ("$method"))
	born_me_method = var_list%get_sval (var_str ("$born_me_method"))
	if (born_me_method == var_str ("")) born_me_method = method
	select case (char (var_list%get_sval (var_str ("$real_partition_mode"))))
	case ("default", "off", "singular")
	use_real_finite = .false.
	case ("all", "on", "finite")
	use_real_finite = .true.
	case default
	call msg_fatal ("The real partition mode can only be " // &
	"default, off, all, on, singular or finite.")
	end select
	if (nlo_fixed_order) then
	real_tree_me_method = &
	var_list%get_sval (var_str ("$real_tree_me_method"))
	if (real_tree_me_method == var_str ("")) &
	real_tree_me_method = method
	loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
	if (loop_me_method == var_str ("")) &
	loop_me_method = method
	correlation_me_method = &
	var_list%get_sval (var_str ("$correlation_me_method"))
	if (correlation_me_method == var_str ("")) &
	correlation_me_method = method
	dglap_me_method = var_list%get_sval (var_str ("$dglap_me_method"))
	if (dglap_me_method == var_str ("")) &
	dglap_me_method = method
	call check_nlo_options (cmd%local)
	end if

	call determine_needed_components ()
	call prc_config%init (cmd%id, n_in, n_components_init, &
	cmd%local%model, cmd%local%var_list, &
	nlo_process = nlo_fixed_order, &
	negative_sf = neg_sf)

	alpha_power = var_list%get_ival (var_str ("alpha_power"))
	alphas_power = var_list%get_ival (var_str ("alphas_power"))
	call prc_config%set_coupling_powers (alpha_power, alphas_power)

	call setup_components ()
	call prc_config%record (cmd%local)

	contains

	<<Commands: cmd process execute procedures>>

	end subroutine cmd_process_execute

	@ %def cmd_process_execute
	@
	<<Commands: cmd process execute procedures>>=
	elemental function is_threshold (method)
	logical :: is_threshold
	type(string_t), intent(in) :: method
	is_threshold = method == var_str ("threshold")
	end function is_threshold

	subroutine check_threshold_consistency ()
	if (nlo_fixed_order .and. is_threshold (born_me_method)) then
	if (.not. (is_threshold (real_tree_me_method) .and. is_threshold (loop_me_method) &
	.and. is_threshold (correlation_me_method))) then
	print *, 'born: ', char (born_me_method)
	print *, 'real: ', char (real_tree_me_method)
	print *, 'loop: ', char (loop_me_method)
	print *, 'correlation: ', char (correlation_me_method)
	call msg_fatal ("Inconsistent methods: All components need to be threshold")
	end if
	end if
	end subroutine check_threshold_consistency

	@ %def check_threshold_consistency
	<<Commands: cmd process execute: check for nlo corrections>>=
	if (nlo_fixed_order .or. gks_active) then
	nlo_correction_type = &
	var_list%get_sval (var_str ('$nlo_correction_type'))
	select case (char (nlo_correction_type))
	case ("QCD")
	qcd_corr = .true.; qed_corr = .false.
	case ("EW")
	qcd_corr = .false.; qed_corr = .true.
	case ("Full")
	qcd_corr =.true.; qed_corr = .true.
	case default
	call msg_fatal ("Invalid NLO correction type. " // &
	"Valid inputs are: QCD, EW, Full (default: QCD)")
	end select
	call check_for_excluded_gauge_boson_splitting_partners ()
	call setup_radiation_generator ()
	end if
	if (nlo_fixed_order) then
	call radiation_generator%find_splittings ()
	if (debug2_active (D_CORE)) then
	print *, ''
	print *, 'Found (pdg) splittings: '
	do i = 1, radiation_generator%if_table%get_length ()
	call radiation_generator%if_table%get_pdg_out (i, pdg)
	call pdg_array_write_set (pdg)
	print *, '----------------'
	end do
	end if

	nlo_fixed_order = radiation_generator%contains_emissions ()
	if (.not. nlo_fixed_order) call msg_warning &
	(arr = [var_str ("No NLO corrections found for process ") // &
	cmd%id // var_str("."), var_str ("Proceed with usual " // &
	"leading-order integration and simulation")])
	end if

	@ %def check_for_nlo_corrections
	@
	<<Commands: cmd process execute procedures>>=
	subroutine check_for_excluded_gauge_boson_splitting_partners ()
	type(string_t) :: str_excluded_partners
	type(string_t), dimension(:), allocatable :: excluded_partners
	type(pdg_list_t) :: pl_tmp, pl_anti
	integer :: i, n_anti
	str_excluded_partners = var_list%get_sval &
	(var_str ("$exclude_gauge_splittings"))
	if (str_excluded_partners == "") then
	return
	else
	call split_string (str_excluded_partners, &
	var_str (":"), excluded_partners)
	call pl_tmp%init (size (excluded_partners))
	do i = 1, size (excluded_partners)
	call pl_tmp%set (i, &
	cmd%local%model%get_pdg (excluded_partners(i), .true.))
	end do
	call pl_tmp%create_antiparticles (pl_anti, n_anti)
	call pl_excluded_gauge_splittings%init (pl_tmp%get_size () + n_anti)
	do i = 1, pl_tmp%get_size ()
	call pl_excluded_gauge_splittings%set (i, pl_tmp%get(i))
	end do
	do i = 1, n_anti
	j = i + pl_tmp%get_size ()
	call pl_excluded_gauge_splittings%set (j, pl_anti%get(i))
	end do
	end if
	end subroutine check_for_excluded_gauge_boson_splitting_partners

	@ %def check_for_excluded_gauge_boson_splitting_partners
	@
	<<Commands: cmd process execute procedures>>=
	subroutine determine_needed_components ()
	type(string_t) :: fks_method
	comp_mult = 1
	if (nlo_fixed_order) then
	fks_method = var_list%get_sval (var_str ('$fks_mapping_type'))
	call check_threshold_consistency ()
	requires_soft_mismatch = fks_method == var_str ('resonances')
	comp_mult = needed_extra_components (requires_dglap_remnants, &
	use_real_finite, requires_soft_mismatch)
	allocate (i_list (comp_mult))
	else if (gks_active) then
	call radiation_generator%generate_multiple &
	(gks_multiplicity, cmd%local%model)
	comp_mult = radiation_generator%get_n_gks_states () + 1
	end if
	n_components_init = n_components * comp_mult
	end subroutine determine_needed_components

	@ %def determine_needed_components
	@
	<<Commands: cmd process execute procedures>>=
	subroutine setup_radiation_generator ()
	call split_prt (prt_spec_in, n_in, pl_in)
	call split_prt (prt_spec_out, n_out, pl_out)
	call radiation_generator%init (pl_in, pl_out, &
	pl_excluded_gauge_splittings, qcd = qcd_corr, qed = qed_corr)
	call radiation_generator%set_n (n_in, n_out, 0)
	initial_state_colored = pdg_in%has_colored_particles ()
	if ((n_in == 2 .and. initial_state_colored) .or. qed_corr) then
	requires_dglap_remnants = n_in == 2 .and. initial_state_colored
	call radiation_generator%set_initial_state_emissions ()
	else
	requires_dglap_remnants = .false.
	end if
	call radiation_generator%set_constraints (.false., .false., .true., .true.)
	call radiation_generator%setup_if_table (cmd%local%model)
	end subroutine setup_radiation_generator

	@ %def setup_radiation_generator
	@
	<<Commands: cmd process execute: scan components>>=
	n_terms = prt_expr_out%get_n_terms ()
	allocate (pdg_out_tab (n_terms))
	allocate (i_term (n_terms), source = 0)
	n_components = 0
	SCAN: do i = 1, n_terms
	if (allocated (ipdg)) deallocate (ipdg)
	call prt_expr_out%term_to_array (prt_spec_out, i)
	n_out = size (prt_spec_out)
	allocate (ipdg (n_out))
	do j = 1, n_out
	prt_out = prt_spec_out(j)%to_string ()
	call split (prt_out, prt_out1, ":")
	ipdg(j) = cmd%local%model%get_pdg (prt_out1)
	end do
	pdg_out = sort (ipdg)
	do j = 1, n_components
	if (pdg_out == pdg_out_tab(j)) cycle SCAN
	end do
	n_components = n_components + 1
	i_term(n_components) = i
	pdg_out_tab(n_components) = pdg_out
	end do SCAN

	@
	<<Commands: cmd process execute procedures>>=
	subroutine split_prt (prt, n_out, pl)
	type(prt_spec_t), intent(in), dimension(:), allocatable :: prt
	integer, intent(in) :: n_out
	type(pdg_list_t), intent(out) :: pl
	type(pdg_array_t) :: pdg
	type(string_t) :: prt_string, prt_tmp
	integer, parameter :: max_particle_number = 25
	integer, dimension(max_particle_number) :: i_particle
	integer :: i, j, n
	i_particle = 0
	call pl%init (n_out)
	do i = 1, n_out
	n = 1
	prt_string = prt(i)%to_string ()
	do
	call split (prt_string, prt_tmp, ":")
	if (prt_tmp /= "") then
	i_particle(n) = cmd%local%model%get_pdg (prt_tmp)
	n = n + 1
	else
	exit
	end if
	end do
	call pdg%init (n - 1)
	do j = 1, n - 1
	call pdg%set (j, i_particle(j))
	end do
	call pl%set (i, pdg)
	call pdg%delete ()
	end do
	end subroutine split_prt

	@ %def split_prt
	@
	<<Commands: cmd process execute procedures>>=
	subroutine setup_components()
	integer :: k, i_comp, add_index
	i_comp = 0
	add_index = 0
	if (debug_on) call msg_debug (D_CORE, "setup_components")
	do i = 1, n_components
	call prt_expr_out%term_to_array (prt_spec_out, i_term(i))
	if (nlo_fixed_order) then
	associate (selected_nlo_parts => cmd%local%selected_nlo_parts)
	if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 1)
	call prc_config%setup_component (i_comp + 1, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, BORN, &
	can_be_integrated = selected_nlo_parts (BORN))
	call radiation_generator%generate_real_particle_strings &
	(prt_in_nlo, prt_out_nlo)
	if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 2)
	call prc_config%setup_component (i_comp + 2, &
	new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
	cmd%local%model, var_list, NLO_REAL, &
	can_be_integrated = selected_nlo_parts (NLO_REAL))
	if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 3)
	call prc_config%setup_component (i_comp + 3, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_VIRTUAL, &
	can_be_integrated = selected_nlo_parts (NLO_VIRTUAL))
	if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 4)
	call prc_config%setup_component (i_comp + 4, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_SUBTRACTION, &
	can_be_integrated = selected_nlo_parts (NLO_SUBTRACTION))
	do k = 1, 4
	i_list(k) = i_comp + k
	end do
	if (requires_dglap_remnants) then
	if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 5)
	call prc_config%setup_component (i_comp + 5, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_DGLAP, &
	can_be_integrated = selected_nlo_parts (NLO_DGLAP))
	i_list(5) = i_comp + 5
	add_index = add_index + 1
	end if
	if (use_real_finite) then
	if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 5 + add_index)
	call prc_config%setup_component (i_comp + 5 + add_index, &
	new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
	cmd%local%model, var_list, NLO_REAL, &
	can_be_integrated = selected_nlo_parts (NLO_REAL))
	i_list(5 + add_index) = i_comp + 5 + add_index
	add_index = add_index + 1
	end if
	if (requires_soft_mismatch) then
	if (debug_on) call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 5 + add_index)
	call prc_config%setup_component (i_comp + 5 + add_index, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_MISMATCH, &
	can_be_integrated = selected_nlo_parts (NLO_MISMATCH))
	i_list(5 + add_index) = i_comp + 5 + add_index
	end if
	call prc_config%set_component_associations (i_list, &
	requires_dglap_remnants, use_real_finite, &
	requires_soft_mismatch)
	end associate
	else if (gks_active) then
	call prc_config%setup_component (i_comp + 1, prt_spec_in, &
	prt_spec_out, cmd%local%model, var_list, BORN, &
	can_be_integrated = .true.)
	call radiation_generator%reset_queue ()
	do j = 1, comp_mult
	prt_out_nlo = radiation_generator%get_next_state ()
	call prc_config%setup_component (i_comp + 1 + j, &
	new_prt_spec (prt_in), new_prt_spec (prt_out_nlo), &
	cmd%local%model, var_list, GKS, can_be_integrated = .false.)
	end do
	else
	call prc_config%setup_component (i, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, can_be_integrated = .true.)
	end if
	i_comp = i_comp + comp_mult
	end do
	end subroutine setup_components

	@
	@ These three functions should be bundled with the logicals they depend
	on into an object (the pcm?).
	<<Commands: procedures>>=
	subroutine check_nlo_options (local)
	type(rt_data_t), intent(in) :: local
	type(var_list_t), pointer :: var_list => null ()
	real :: mult_real, mult_virt, mult_dglap
	logical :: combined, powheg
	logical :: case_lo_but_any_other
	logical :: fixed_order_nlo_events
	logical :: real_finite_only
	var_list => local%get_var_list_ptr ()
	combined = var_list%get_lval (var_str ('?combined_nlo_integration'))
	powheg = var_list%get_lval (var_str ('?powheg_matching'))
	if (powheg .and. .not. combined) then
	call msg_fatal ("POWHEG matching requires the 'combined_nlo_integration' &
	&-option to be set to true.")
	end if
	fixed_order_nlo_events = &
	var_list%get_lval (var_str ('?fixed_order_nlo_events'))
	if (fixed_order_nlo_events .and. .not. combined .and. &
	count (local%selected_nlo_parts) > 1) &
	call msg_fatal ("Option mismatch: Fixed order NLO events of multiple ", &
	[var_str ("components are requested, but ?combined_nlo_integration "), &
	var_str ("is false. You can either switch to the combined NLO "), &
	var_str ("integration mode for the full process or choose one "), &
	var_str ("individual NLO component to generate events with.")])
	real_finite_only = local%var_list%get_sval (var_str ("$real_partition_mode")) == "finite"
	associate (nlo_parts => local%selected_nlo_parts)
	! TODO (PS-2020-03-26): This technically leaves the possibility to skip this
	! message by deactivating the dglap component for a proton collider process.
	! To circumvent this, the selected_nlo_parts should be refactored.
	if (combined .and. .not. (nlo_parts(BORN) &
	.and. nlo_parts(NLO_VIRTUAL) .and. nlo_parts(NLO_REAL))) then
	call msg_fatal ("A combined integration of anything else than", &
	[var_str ("all NLO components together is not supported.")])
	end if
	if (real_finite_only .and. combined) then
	call msg_fatal ("You cannot do a combined integration without", &
	[var_str ("the real singular component.")])
	end if
	if (real_finite_only .and. count(nlo_parts([BORN,NLO_VIRTUAL,NLO_DGLAP])) > 1) then
	call msg_fatal ("You cannot do a full NLO integration without", &
	[var_str ("the real singular component.")])
	end if
	end associate
	mult_real = local%var_list%get_rval (var_str ("mult_call_real"))
	mult_virt = local%var_list%get_rval (var_str ("mult_call_virt"))
	mult_dglap = local%var_list%get_rval (var_str ("mult_call_dglap"))
	if (combined .and. (mult_real /= one .or. mult_virt /= one .or. mult_dglap /= one)) then
	call msg_warning ("mult_call_real, mult_call_virt and mult_call_dglap", &
	[var_str (" will be ignored because of ?combined_nlo_integration = true. ")])
	end if
	end subroutine check_nlo_options

	@ %def check_nlo_options
	@ There are four components for a general NLO process, namely Born,
	real, virtual and subtraction. There will be additional components for
	DGLAP remnant, in case real contributions are split into singular and
	finite pieces, and for resonance-aware FKS subtraction for the needed
	soft mismatch component.
	<<Commands: procedures>>=
	pure function needed_extra_components (requires_dglap_remnant, &
	use_real_finite, requires_soft_mismatch) result (n)
	integer :: n
	logical, intent(in) :: requires_dglap_remnant, &
	use_real_finite, requires_soft_mismatch
	n = 4
	if (requires_dglap_remnant) n = n + 1
	if (use_real_finite) n = n + 1
	if (requires_soft_mismatch) n = n + 1
	end function needed_extra_components

	@ %def needed_extra_components
	@ This is a method of the eval tree, but cannot be coded inside the
	[[expressions]] module since it uses the [[model]] and [[flv]] types
	which are not available there.
	<<Commands: procedures>>=
	function make_flavor_string (aval, model) result (prt)
	type(string_t) :: prt
	type(pdg_array_t), intent(in) :: aval
	type(model_t), intent(in), target :: model
	integer, dimension(:), allocatable :: pdg
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: i
	pdg = aval
	allocate (flv (size (pdg)))
	call flv%init (pdg, model)
	if (size (pdg) /= 0) then
	prt = flv(1)%get_name ()
	do i = 2, size (flv)
	prt = prt // ":" // flv(i)%get_name ()
	end do
	else
	prt = "?"
	end if
	end function make_flavor_string

	@ %def make_flavor_string
	@ Create a pdg array from a particle-specification array
	<<Commands: procedures>>=
	function make_pdg_array (prt, model) result (pdg_array)
	type(prt_spec_t), intent(in), dimension(:) :: prt
	type(model_t), intent(in) :: model
	integer, dimension(:), allocatable :: aval
	type(pdg_array_t) :: pdg_array
	type(flavor_t) :: flv
	integer :: k
	allocate (aval (size (prt)))
	do k = 1, size (prt)
	call flv%init (prt(k)%to_string (), model)
	aval (k) = flv%get_pdg ()
	end do
	pdg_array = aval
	end function make_pdg_array

	@ %def make_pdg_array
	@ Compile a (possible nested) expression, to obtain a
	particle-specifier expression which we can process further.
	<<Commands: procedures>>=
	recursive subroutine compile_prt_expr (prt_expr, pn, var_list, model)
	type(prt_expr_t), intent(out) :: prt_expr
	type(parse_node_t), intent(in), target :: pn
	type(var_list_t), intent(in), target :: var_list
	type(model_t), intent(in), target :: model
	type(parse_node_t), pointer :: pn_entry, pn_term, pn_addition
	type(pdg_array_t) :: pdg
	type(string_t) :: prt_string
	integer :: n_entry, n_term, i
	select case (char (parse_node_get_rule_key (pn)))
	case ("prt_state_list")
	n_entry = parse_node_get_n_sub (pn)
	pn_entry => parse_node_get_sub_ptr (pn)
	if (n_entry == 1) then
	call compile_prt_expr (prt_expr, pn_entry, var_list, model)
	else
	call prt_expr%init_list (n_entry)
	select type (x => prt_expr%x)
	type is (prt_spec_list_t)
	do i = 1, n_entry
	call compile_prt_expr (x%expr(i), pn_entry, var_list, model)
	pn_entry => parse_node_get_next_ptr (pn_entry)
	end do
	end select
	end if
	case ("prt_state_sum")
	n_term = parse_node_get_n_sub (pn)
	pn_term => parse_node_get_sub_ptr (pn)
	pn_addition => pn_term
	if (n_term == 1) then
	call compile_prt_expr (prt_expr, pn_term, var_list, model)
	else
	call prt_expr%init_sum (n_term)
	select type (x => prt_expr%x)
	type is (prt_spec_sum_t)
	do i = 1, n_term
	call compile_prt_expr (x%expr(i), pn_term, var_list, model)
	pn_addition => parse_node_get_next_ptr (pn_addition)
	if (associated (pn_addition)) &
	pn_term => parse_node_get_sub_ptr (pn_addition, 2)
	end do
	end select
	end if
	case ("cexpr")
	pdg = eval_pdg_array (pn, var_list)
	prt_string = make_flavor_string (pdg, model)
	call prt_expr%init_spec (new_prt_spec (prt_string))
	case default
	call parse_node_write_rec (pn)
	call msg_bug ("compile prt expr: impossible syntax rule")
	end select
	end subroutine compile_prt_expr

	@ %def compile_prt_expr
	@
	\subsubsection{Initiating a NLO calculation}
	<<Commands: types>>=
	type, extends (command_t) :: cmd_nlo_t
	private
	integer, dimension(:), allocatable :: nlo_component
	contains
	<<Commands: cmd nlo: TBP>>
	end type cmd_nlo_t

	@ %def cmd_nlo_t
	@ Incomplete.
	<<Commands: cmd nlo: TBP>>=
	procedure :: write => cmd_nlo_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_nlo_write (cmd, unit, indent)
	class(cmd_nlo_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_nlo_write
	<<Commands: procedures>>=
	module subroutine cmd_nlo_write (cmd, unit, indent)
	class(cmd_nlo_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_nlo_write

	@ %def cmd_nlo_write
	@ As it is, the NLO calculation is switched on by putting {nlo} behind
	the process definition. This should be made nicer in the future.
	<<Commands: cmd nlo: TBP>>=
	procedure :: compile => cmd_nlo_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_nlo_compile (cmd, global)
	class(cmd_nlo_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_nlo_compile
	<<Commands: procedures>>=
	module subroutine cmd_nlo_compile (cmd, global)
	class(cmd_nlo_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_comp
	integer :: i, n_comp
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
	if (associated (pn_arg)) then
	n_comp = parse_node_get_n_sub (pn_arg)
	allocate (cmd%nlo_component (n_comp))
	pn_comp => parse_node_get_sub_ptr (pn_arg)
	i = 0
	do while (associated (pn_comp))
	i = i + 1
	cmd%nlo_component(i) = component_status &
	(parse_node_get_rule_key (pn_comp))
	pn_comp => parse_node_get_next_ptr (pn_comp)
	end do
	else
	allocate (cmd%nlo_component (0))
	end if
	end subroutine cmd_nlo_compile

	@ %def cmd_nlo_compile
	@ % TODO (PS-2020-03-26): This routine still needs to be adopted
	% to cope with more than 5 components.
	<<Commands: cmd nlo: TBP>>=
	procedure :: execute => cmd_nlo_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_nlo_execute (cmd, global)
	class(cmd_nlo_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_nlo_execute
	<<Commands: procedures>>=
	module subroutine cmd_nlo_execute (cmd, global)
	class(cmd_nlo_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(string_t) :: string
	integer :: n, i, j
	logical, dimension(0:5) :: selected_nlo_parts
	if (debug_on) call msg_debug (D_CORE, "cmd_nlo_execute")
	selected_nlo_parts = .false.
	if (allocated (cmd%nlo_component)) then
	n = size (cmd%nlo_component)
	else
	n = 0
	end if
	do i = 1, n
	select case (cmd%nlo_component (i))
	case (BORN, NLO_VIRTUAL, NLO_MISMATCH, NLO_DGLAP, NLO_REAL)
	selected_nlo_parts(cmd%nlo_component (i)) = .true.
	case (NLO_FULL)
	selected_nlo_parts = .true.
	selected_nlo_parts (NLO_SUBTRACTION) = .false.
	case default
	string = var_str ("")
	do j = BORN, NLO_DGLAP
	string = string // component_status (j) // ", "
	end do
	string = string // component_status (NLO_FULL)
	call msg_fatal ("Invalid NLO mode. Valid modes are: " // &
	char (string))
	end select
	end do
	global%nlo_fixed_order = any (selected_nlo_parts)
	global%selected_nlo_parts = selected_nlo_parts
	allocate (global%nlo_component (size (cmd%nlo_component)))
	global%nlo_component = cmd%nlo_component
	end subroutine cmd_nlo_execute

	@ %def cmd_nlo_execute
	@
	\subsubsection{Process compilation}
	<<Commands: types>>=
	type, extends (command_t) :: cmd_compile_t
	private
	type(string_t), dimension(:), allocatable :: libname
	logical :: make_executable = .false.
	type(string_t) :: exec_name
	contains
	<<Commands: cmd compile: TBP>>
	end type cmd_compile_t

	@ %def cmd_compile_t
	@ Output: list all libraries to be compiled.
	<<Commands: cmd compile: TBP>>=
	procedure :: write => cmd_compile_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_compile_write (cmd, unit, indent)
	class(cmd_compile_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_compile_write
	<<Commands: procedures>>=
	module subroutine cmd_compile_write (cmd, unit, indent)
	class(cmd_compile_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "compile ("
	if (allocated (cmd%libname)) then
	do i = 1, size (cmd%libname)
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "('""',A,'""')", advance="no") char (cmd%libname(i))
	end do
	end if
	write (u, "(A)") ")"
	end subroutine cmd_compile_write

	@ %def cmd_compile_write
	@ Compile the libraries specified in the argument. If the argument is
	empty, compile all libraries which can be found in the process library stack.
	<<Commands: cmd compile: TBP>>=
	procedure :: compile => cmd_compile_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_compile_compile (cmd, global)
	class(cmd_compile_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_compile_compile
	<<Commands: procedures>>=
	module subroutine cmd_compile_compile (cmd, global)
	class(cmd_compile_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_cmd, pn_clause, pn_arg, pn_lib
	type(parse_node_t), pointer :: pn_exec_name_spec, pn_exec_name
	integer :: n_lib, i
	pn_cmd => parse_node_get_sub_ptr (cmd%pn)
	pn_clause => parse_node_get_sub_ptr (pn_cmd)
	pn_exec_name_spec => parse_node_get_sub_ptr (pn_clause, 2)
	if (associated (pn_exec_name_spec)) then
	pn_exec_name => parse_node_get_sub_ptr (pn_exec_name_spec, 2)
	else
	pn_exec_name => null ()
	end if
	pn_arg => parse_node_get_next_ptr (pn_clause)
	cmd%pn_opt => parse_node_get_next_ptr (pn_cmd)
	call cmd%compile_options (global)
	if (associated (pn_arg)) then
	n_lib = parse_node_get_n_sub (pn_arg)
	else
	n_lib = 0
	end if
	if (n_lib > 0) then
	allocate (cmd%libname (n_lib))
	pn_lib => parse_node_get_sub_ptr (pn_arg)
	do i = 1, n_lib
	cmd%libname(i) = parse_node_get_string (pn_lib)
	pn_lib => parse_node_get_next_ptr (pn_lib)
	end do
	end if
	if (associated (pn_exec_name)) then
	cmd%make_executable = .true.
	cmd%exec_name = parse_node_get_string (pn_exec_name)
	end if
	end subroutine cmd_compile_compile

	@ %def cmd_compile_compile
	@ Command execution. Generate code, write driver, compile and link.
	Do this for all libraries in the list.

	If no library names have been given and stored while compiling this
	command, we collect all libraries from the current stack and compile
	those.

	As a bonus, a compiled library may be able to spawn new process
	libraries. For instance, a processes may ask for a set of resonant
	subprocesses which go into their own library, but this can be
	determined only after the process is available as a compiled object.
	Therefore, the compilation loop is implemented as a recursive internal
	subroutine.

	We can compile static libraries (which actually just loads them). However, we
	can't incorporate in a generated executable.
	<<Commands: cmd compile: TBP>>=
	procedure :: execute => cmd_compile_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_compile_execute (cmd, global)
	class(cmd_compile_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_compile_execute
	<<Commands: procedures>>=
	module subroutine cmd_compile_execute (cmd, global)
	class(cmd_compile_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(string_t), dimension(:), allocatable :: libname, libname_static
	integer :: i, n_lib
	<<Commands: cmd compile execute: extra variables>>
	<<Commands: cmd compile execute: extra init>>
	if (allocated (cmd%libname)) then
	allocate (libname (size (cmd%libname)))
	libname = cmd%libname
	else
	call cmd%local%prclib_stack%get_names (libname)
	end if
	n_lib = size (libname)
	if (cmd%make_executable) then
	call get_prclib_static (libname_static)
	do i = 1, n_lib
	if (any (libname_static == libname(i))) then
	call msg_fatal ("Compile: can't include static library '" &
	// char (libname(i)) // "'")
	end if
	end do
	call compile_executable (cmd%exec_name, libname, cmd%local)
	else
	call compile_libraries (libname)
	call global%update_prclib &
	(global%prclib_stack%get_library_ptr (libname(n_lib)))
	end if
	<<Commands: cmd compile execute: extra end init>>
	contains
	recursive subroutine compile_libraries (libname)
	type(string_t), dimension(:), intent(in) :: libname
	integer :: i
	type(string_t), dimension(:), allocatable :: libname_extra
	type(process_library_t), pointer :: lib_saved
	do i = 1, size (libname)
	call compile_library (libname(i), cmd%local)
	lib_saved => global%prclib
	call spawn_extra_libraries &
	(libname(i), cmd%local, global, libname_extra)
	call compile_libraries (libname_extra)
	call global%update_prclib (lib_saved)
	end do
	end subroutine compile_libraries
	end subroutine cmd_compile_execute

	@ %def cmd_compile_execute
	<<Commands: cmd compile execute: extra variables>>=
	<<Commands: cmd compile execute: extra init>>=
	<<Commands: cmd compile execute: extra end init>>=
	@ The parallelization leads to undefined behavior while writing simultaneously to one file.
	The master worker has to initialize single-handed the corresponding library files.
	The slave worker will wait with a blocking [[MPI_BCAST]] until they receive a logical flag.
	<<MPI: Commands: cmd compile execute: extra variables>>=
	logical :: compile_init
	integer :: rank, n_size
	<<MPI: Commands: cmd compile execute: extra init>>=
	if (debug_on) call msg_debug (D_MPI, "cmd_compile_execute")
	compile_init = .false.
	call mpi_get_comm_id (n_size, rank)
	if (debug_on) call msg_debug (D_MPI, "n_size", rank)
	if (debug_on) call msg_debug (D_MPI, "rank", rank)
	if (rank /= 0) then
	if (debug_on) call msg_debug (D_MPI, "wait for master")
	call MPI_bcast (compile_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
	else
	compile_init = .true.
	end if

	if (compile_init) then
	<<MPI: Commands: cmd compile execute: extra end init>>=
	if (rank == 0) then
	if (debug_on) call msg_debug (D_MPI, "load slaves")
	call MPI_bcast (compile_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
	end if
	end if
	call MPI_barrier (MPI_COMM_WORLD)
	@ %def cmd_compile_execute_mpi
	@
	This is the interface to the external procedure which returns the
	names of all static libraries which are part of the executable. (The
	default is none.) The routine must allocate the array.
	<<Commands: public>>=
	public :: get_prclib_static
	<<Commands: interfaces>>=
	interface
	subroutine get_prclib_static (libname)
	import
	type(string_t), dimension(:), intent(inout), allocatable :: libname
	end subroutine get_prclib_static
	end interface

	@ %def get_prclib_static
	@
	Spawn extra libraries. We can ask the processes within a compiled
	library, which we have available at this point, whether they need additional
	processes which should go into their own libraries.

	The current implementation only concerns resonant subprocesses.

	Note that the libraries should be created (source code), but not be
	compiled here. This is done afterwards.
	<<Commands: procedures>>=
	subroutine spawn_extra_libraries (libname, local, global, libname_extra)
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), target :: global
	type(string_t), dimension(:), allocatable, intent(out) :: libname_extra
	type(string_t), dimension(:), allocatable :: libname_res
	allocate (libname_extra (0))
	call spawn_resonant_subprocess_libraries &
	(libname, local, global, libname_res)
	if (allocated (libname_res)) libname_extra = [libname_extra, libname_res]
	end subroutine spawn_extra_libraries

	@ %def spawn_extra_libraries
	@
	\subsubsection{Execute a shell command}
	The argument is a string expression.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_exec_t
	private
	type(parse_node_t), pointer :: pn_command => null ()
	contains
	<<Commands: cmd exec: TBP>>
	end type cmd_exec_t

	@ %def cmd_exec_t
	@ Simply tell the status.
	<<Commands: cmd exec: TBP>>=
	procedure :: write => cmd_exec_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_exec_write (cmd, unit, indent)
	class(cmd_exec_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_exec_write
	<<Commands: procedures>>=
	module subroutine cmd_exec_write (cmd, unit, indent)
	class(cmd_exec_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	if (associated (cmd%pn_command)) then
	write (u, "(1x,A)") "exec: [command associated]"
	else
	write (u, "(1x,A)") "exec: [undefined]"
	end if
	end subroutine cmd_exec_write

	@ %def cmd_exec_write
	@ Compile the exec command.
	<<Commands: cmd exec: TBP>>=
	procedure :: compile => cmd_exec_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_exec_compile (cmd, global)
	class(cmd_exec_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_exec_compile
	<<Commands: procedures>>=
	module subroutine cmd_exec_compile (cmd, global)
	class(cmd_exec_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_command
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_command => parse_node_get_sub_ptr (pn_arg)
	cmd%pn_command => pn_command
	end subroutine cmd_exec_compile

	@ %def cmd_exec_compile
	@ Execute the specified shell command.
	<<Commands: cmd exec: TBP>>=
	procedure :: execute => cmd_exec_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_exec_execute (cmd, global)
	class(cmd_exec_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_exec_execute
	<<Commands: procedures>>=
	module subroutine cmd_exec_execute (cmd, global)
	class(cmd_exec_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(string_t) :: command
	logical :: is_known
	integer :: status
	command = eval_string (cmd%pn_command, global%var_list, is_known=is_known)
	if (is_known) then
	if (command /= "") then
	call os_system_call (command, status, verbose=.true.)
	if (status /= 0) then
	write (msg_buffer, "(A,I0)") "Return code = ", status
	call msg_message ()
	call msg_error ("System command returned with nonzero status code")
	end if
	end if
	end if
	end subroutine cmd_exec_execute

	@ %def cmd_exec_execute
	@
	\subsubsection{Variable declaration}
	A variable can have various types. Hold the definition as an eval
	tree.

	There are intrinsic variables, user variables, and model variables.
	The latter are further divided in independent variables and dependent
	variables.

	Regarding model variables: When dealing with them, we always look at
	two variable lists in parallel. The global (or local) variable list
	contains the user-visible values. It includes variables that
	correspond to variables in the current model's list. These, in turn,
	are pointers to the model's parameter list, so the model is always in
	sync, internally. To keep the global variable list in sync with the
	model, the global variables carry the [[is_copy]] property and contain
	a separate pointer to the model variable. (The pointer is reassigned
	whenever the model changes.) Modifying the global variable changes
	two values simultaneously: the visible value and the model variable,
	via this extra pointer. After each modification, we update dependent
	parameters in the model variable list and re-synchronize the global
	variable list (again, using these pointers) with the model variable
	this. In the last step, modifications in the derived parameters
	become visible.

	When we integrate a process, we capture the current variable list of
	the current model in a separate model instance, which is stored in the
	process object. Thus, the model parameters associated to this process
	at this time are preserved for the lifetime of the process object.

	When we generate or rescan events, we can again capture a local model
	variable list in a model instance. This allows us to reweight event
	by event with different parameter sets simultaneously.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_var_t
	private
	type(string_t) :: name
	integer :: type = V_NONE
	type(parse_node_t), pointer :: pn_value => null ()
	logical :: is_intrinsic = .false.
	logical :: is_model_var = .false.
	contains
	<<Commands: cmd var: TBP>>
	end type cmd_var_t

	@ %def cmd_var_t
	@ Output. We know name, type, and properties, but not the value.
	<<Commands: cmd var: TBP>>=
	procedure :: write => cmd_var_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_var_write (cmd, unit, indent)
	class(cmd_var_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_var_write
	<<Commands: procedures>>=
	module subroutine cmd_var_write (cmd, unit, indent)
	class(cmd_var_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A,A)", advance="no") "var: ", char (cmd%name), " ("
	select case (cmd%type)
	case (V_NONE)
	write (u, "(A)", advance="no") "[unknown]"
	case (V_LOG)
	write (u, "(A)", advance="no") "logical"
	case (V_INT)
	write (u, "(A)", advance="no") "int"
	case (V_REAL)
	write (u, "(A)", advance="no") "real"
	case (V_CMPLX)
	write (u, "(A)", advance="no") "complex"
	case (V_STR)
	write (u, "(A)", advance="no") "string"
	case (V_PDG)
	write (u, "(A)", advance="no") "alias"
	end select
	if (cmd%is_intrinsic) then
	write (u, "(A)", advance="no") ", intrinsic"
	end if
	if (cmd%is_model_var) then
	write (u, "(A)", advance="no") ", model"
	end if
	write (u, "(A)") ")"
	end subroutine cmd_var_write

	@ %def cmd_var_write
	@ Compile the lhs and determine the variable name and type. Check whether
	this variable can be created or modified as requested, and append the value to
	the variable list, if appropriate. The value is initially undefined.
	The rhs is assigned to a pointer, to be compiled and evaluated when the
	command is executed.
	<<Commands: cmd var: TBP>>=
	procedure :: compile => cmd_var_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_var_compile (cmd, global)
	class(cmd_var_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_var_compile
	<<Commands: procedures>>=
	module subroutine cmd_var_compile (cmd, global)
	class(cmd_var_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_var, pn_name
	type(parse_node_t), pointer :: pn_result, pn_proc
	type(string_t) :: var_name
	type(var_list_t), pointer :: model_vars
	integer :: type
	logical :: new
	pn_result => null ()
	new = .false.
	select case (char (parse_node_get_rule_key (cmd%pn)))
	case ("cmd_log_decl"); type = V_LOG
	pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
	if (.not. associated (pn_var)) then ! handle masked syntax error
	cmd%type = V_NONE; return
	end if
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	new = .true.
	case ("cmd_log"); type = V_LOG
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	case ("cmd_int"); type = V_INT
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	new = .true.
	case ("cmd_real"); type = V_REAL
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	new = .true.
	case ("cmd_complex"); type = V_CMPLX
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	new = .true.
	case ("cmd_num"); type = V_NONE
	pn_name => parse_node_get_sub_ptr (cmd%pn)
	case ("cmd_string_decl"); type = V_STR
	pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
	if (.not. associated (pn_var)) then ! handle masked syntax error
	cmd%type = V_NONE; return
	end if
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	new = .true.
	case ("cmd_string"); type = V_STR
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	case ("cmd_alias"); type = V_PDG
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	new = .true.
	case ("cmd_result"); type = V_REAL
	pn_name => parse_node_get_sub_ptr (cmd%pn)
	pn_result => parse_node_get_sub_ptr (pn_name)
	pn_proc => parse_node_get_next_ptr (pn_result)
	case default
	call parse_node_mismatch &
	("logical\|int\|real\|complex\|?\|$\|alias\|var_name", cmd%pn) ! $
	end select
	if (.not. associated (pn_name)) then ! handle masked syntax error
	cmd%type = V_NONE; return
	end if
	if (.not. associated (pn_result)) then
	var_name = parse_node_get_string (pn_name)
	else
	var_name = parse_node_get_key (pn_result) &
	// "(" // parse_node_get_string (pn_proc) // ")"
	end if
	select case (type)
	case (V_LOG); var_name = "?" // var_name
	case (V_STR); var_name = "$" // var_name ! $
	end select
	if (associated (global%model)) then
	model_vars => global%model%get_var_list_ptr ()
	else
	model_vars => null ()
	end if
	call var_list_check_observable (global%var_list, var_name, type)
	call var_list_check_result_var (global%var_list, var_name, type)
	call global%var_list%check_user_var (var_name, type, new)
	cmd%name = var_name
	cmd%pn_value => parse_node_get_next_ptr (pn_name, 2)
	if (global%var_list%contains (cmd%name, follow_link = .false.)) then
	! local variable
	cmd%is_intrinsic = &
	global%var_list%is_intrinsic (cmd%name, follow_link = .false.)
	cmd%type = &
	global%var_list%get_type (cmd%name, follow_link = .false.)
	else
	if (new) cmd%type = type
	if (global%var_list%contains (cmd%name, follow_link = .true.)) then
	! global variable
	cmd%is_intrinsic = &
	global%var_list%is_intrinsic (cmd%name, follow_link = .true.)
	if (cmd%type == V_NONE) then
	cmd%type = &
	global%var_list%get_type (cmd%name, follow_link = .true.)
	end if
	else if (associated (model_vars)) then ! check model variable
	cmd%is_model_var = &
	model_vars%contains (cmd%name)
	if (cmd%type == V_NONE) then
	cmd%type = &
	model_vars%get_type (cmd%name)
	end if
	end if
	if (cmd%type == V_NONE) then
	call msg_fatal ("Variable '" // char (cmd%name) // "' " &
	// "set without declaration")
	cmd%type = V_NONE; return
	end if
	if (cmd%is_model_var) then
	if (new) then
	call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
	// "redeclared")
	else if (model_vars%is_locked (cmd%name)) then
	call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
	// "is locked")
	end if
	else
	select case (cmd%type)
	case (V_LOG)
	call global%var_list%append_log (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_INT)
	call global%var_list%append_int (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_REAL)
	call global%var_list%append_real (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_CMPLX)
	call global%var_list%append_cmplx (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_PDG)
	call global%var_list%append_pdg_array (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_STR)
	call global%var_list%append_string (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	end select
	end if
	end if
	end subroutine cmd_var_compile

	@ %def cmd_var_compile
	@ Execute. Evaluate the definition and assign the variable value.
	If the variable is a model variable, take a snapshot of the model if necessary
	and set the variable in the local model.
	<<Commands: cmd var: TBP>>=
	procedure :: execute => cmd_var_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_var_execute (cmd, global)
	class(cmd_var_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_var_execute
	<<Commands: procedures>>=
	module subroutine cmd_var_execute (cmd, global)
	class(cmd_var_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default) :: rval
	logical :: is_known, pacified
	var_list => global%get_var_list_ptr ()
	if (cmd%is_model_var) then
	pacified = var_list%get_lval (var_str ("?pacify"))
	rval = eval_real (cmd%pn_value, var_list, is_known=is_known)
	call global%model_set_real &
	(cmd%name, rval, verbose=.true., pacified=pacified)
	else if (cmd%type /= V_NONE) then
	call cmd%set_value (var_list, verbose=.true.)
	end if
	end subroutine cmd_var_execute

	@ %def cmd_var_execute
	@ Copy the value to the variable list, where the variable should already exist.
	<<Commands: cmd var: TBP>>=
	procedure :: set_value => cmd_var_set_value
	<<Commands: sub interfaces>>=
	module subroutine cmd_var_set_value (var, var_list, verbose, model_name)
	class(cmd_var_t), intent(inout) :: var
	type(var_list_t), intent(inout), target :: var_list
	logical, intent(in), optional :: verbose
	type(string_t), intent(in), optional :: model_name
	end subroutine cmd_var_set_value
	<<Commands: procedures>>=
	module subroutine cmd_var_set_value (var, var_list, verbose, model_name)
	class(cmd_var_t), intent(inout) :: var
	type(var_list_t), intent(inout), target :: var_list
	logical, intent(in), optional :: verbose
	type(string_t), intent(in), optional :: model_name
	logical :: lval, pacified
	integer :: ival
	real(default) :: rval
	complex(default) :: cval
	type(pdg_array_t) :: aval
	type(string_t) :: sval
	logical :: is_known
	pacified = var_list%get_lval (var_str ("?pacify"))
	select case (var%type)
	case (V_LOG)
	lval = eval_log (var%pn_value, var_list, is_known=is_known)
	call var_list%set_log (var%name, &
	lval, is_known, verbose=verbose, model_name=model_name)
	case (V_INT)
	ival = eval_int (var%pn_value, var_list, is_known=is_known)
	call var_list%set_int (var%name, &
	ival, is_known, verbose=verbose, model_name=model_name)
	case (V_REAL)
	rval = eval_real (var%pn_value, var_list, is_known=is_known)
	call var_list%set_real (var%name, &
	rval, is_known, verbose=verbose, &
	model_name=model_name, pacified = pacified)
	case (V_CMPLX)
	cval = eval_cmplx (var%pn_value, var_list, is_known=is_known)
	call var_list%set_cmplx (var%name, &
	cval, is_known, verbose=verbose, &
	model_name=model_name, pacified = pacified)
	case (V_PDG)
	aval = eval_pdg_array (var%pn_value, var_list, is_known=is_known)
	call var_list%set_pdg_array (var%name, &
	aval, is_known, verbose=verbose, model_name=model_name)
	case (V_STR)
	sval = eval_string (var%pn_value, var_list, is_known=is_known)
	call var_list%set_string (var%name, &
	sval, is_known, verbose=verbose, model_name=model_name)
	end select
	end subroutine cmd_var_set_value

	@ %def cmd_var_set_value
	@
	\subsubsection{SLHA}
	Read a SLHA (SUSY Les Houches Accord) file to fill the appropriate
	model parameters. We do not access the current variable record, but
	directly work on the appropriate SUSY model, which is loaded if
	necessary.

	We may be in read or write mode. In the latter case, we may write
	just input parameters, or the complete spectrum, or the spectrum with
	all decays.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_slha_t
	private
	type(string_t) :: file
	logical :: write_mode = .false.
	contains
	<<Commands: cmd slha: TBP>>
	end type cmd_slha_t

	@ %def cmd_slha_t
	@ Output.
	<<Commands: cmd slha: TBP>>=
	procedure :: write => cmd_slha_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_slha_write (cmd, unit, indent)
	class(cmd_slha_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_slha_write
	<<Commands: procedures>>=
	module subroutine cmd_slha_write (cmd, unit, indent)
	class(cmd_slha_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A)") "slha: file name = ", char (cmd%file)
	write (u, "(1x,A,L1)") "slha: write mode = ", cmd%write_mode
	end subroutine cmd_slha_write

	@ %def cmd_slha_write
	@ Compile. Read the filename and store it.
	<<Commands: cmd slha: TBP>>=
	procedure :: compile => cmd_slha_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_slha_compile (cmd, global)
	class(cmd_slha_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_slha_compile
	<<Commands: procedures>>=
	module subroutine cmd_slha_compile (cmd, global)
	class(cmd_slha_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_key, pn_arg, pn_file
	pn_key => parse_node_get_sub_ptr (cmd%pn)
	pn_arg => parse_node_get_next_ptr (pn_key)
	pn_file => parse_node_get_sub_ptr (pn_arg)
	call cmd%compile_options (global)
	cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
	select case (char (parse_node_get_key (pn_key)))
	case ("read_slha")
	cmd%write_mode = .false.
	case ("write_slha")
	cmd%write_mode = .true.
	case default
	call parse_node_mismatch ("read_slha\|write_slha", cmd%pn)
	end select
	cmd%file = parse_node_get_string (pn_file)
	end subroutine cmd_slha_compile

	@ %def cmd_slha_compile
	@ Execute. Read or write the specified SLHA file. Behind the scenes,
	this will first read the WHIZARD model file, then read the SLHA file
	and assign the SLHA parameters as far as determined by
	[[dispatch_slha]]. Finally, the global variables are synchronized
	with the model. This is similar to executing [[cmd_model]].
	<<Commands: cmd slha: TBP>>=
	procedure :: execute => cmd_slha_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_slha_execute (cmd, global)
	class(cmd_slha_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_slha_execute
	<<Commands: procedures>>=
	module subroutine cmd_slha_execute (cmd, global)
	class(cmd_slha_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	logical :: input, spectrum, decays
	if (cmd%write_mode) then
	input = .true.
	spectrum = .false.
	decays = .false.
	if (.not. associated (cmd%local%model)) then
	call msg_fatal ("SLHA: local model not associated")
	return
	end if
	call slha_write_file &
	(cmd%file, cmd%local%model, &
	input = input, spectrum = spectrum, decays = decays)
	else
	if (.not. associated (global%model)) then
	call msg_fatal ("SLHA: global model not associated")
	return
	end if
	call dispatch_slha (cmd%local%var_list, &
	input = input, spectrum = spectrum, decays = decays)
	call global%ensure_model_copy ()
	call slha_read_file &
	(cmd%file, cmd%local%os_data, global%model, &
	input = input, spectrum = spectrum, decays = decays)
	end if
	end subroutine cmd_slha_execute

	@ %def cmd_slha_execute
	@
	\subsubsection{Show values}
	This command shows the current values of variables or other objects,
	in a suitably condensed form.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_show_t
	private
	type(string_t), dimension(:), allocatable :: name
	contains
	<<Commands: cmd show: TBP>>
	end type cmd_show_t

	@ %def cmd_show_t
	@ Output: list the object names, not values.
	<<Commands: cmd show: TBP>>=
	procedure :: write => cmd_show_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_show_write (cmd, unit, indent)
	class(cmd_show_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_show_write
	<<Commands: procedures>>=
	module subroutine cmd_show_write (cmd, unit, indent)
	class(cmd_show_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "show: "
	if (allocated (cmd%name)) then
	do i = 1, size (cmd%name)
	write (u, "(1x,A)", advance="no") char (cmd%name(i))
	end do
	write (u, *)
	else
	write (u, "(5x,A)") "[undefined]"
	end if
	end subroutine cmd_show_write

	@ %def cmd_show_write
	@ Compile. Allocate an array which is filled with the names of the
	variables to show.
	<<Commands: cmd show: TBP>>=
	procedure :: compile => cmd_show_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_show_compile (cmd, global)
	class(cmd_show_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_show_compile
	<<Commands: procedures>>=
	module subroutine cmd_show_compile (cmd, global)
	class(cmd_show_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
	type(string_t) :: key
	integer :: i, n_args
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (pn_arg)) then
	select case (char (parse_node_get_rule_key (pn_arg)))
	case ("show_arg")
	cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
	case default
	cmd%pn_opt => pn_arg
	pn_arg => null ()
	end select
	end if
	call cmd%compile_options (global)
	if (associated (pn_arg)) then
	n_args = parse_node_get_n_sub (pn_arg)
	allocate (cmd%name (n_args))
	pn_var => parse_node_get_sub_ptr (pn_arg)
	i = 0
	do while (associated (pn_var))
	i = i + 1
	select case (char (parse_node_get_rule_key (pn_var)))
	case ("model", "library", "beams", "iterations", &
	"cuts", "weight", "int", "real", "complex", &
	"scale", "factorization_scale", "renormalization_scale", &
	"selection", "reweight", "analysis", "pdg", &
	"stable", "unstable", "polarized", "unpolarized", &
	"results", "expect", "intrinsic", "string", "logical")
	cmd%name(i) = parse_node_get_key (pn_var)
	case ("result_var")
	pn_prefix => parse_node_get_sub_ptr (pn_var)
	pn_name => parse_node_get_next_ptr (pn_prefix)
	if (associated (pn_name)) then
	cmd%name(i) = parse_node_get_key (pn_prefix) &
	// "(" // parse_node_get_string (pn_name) // ")"
	else
	cmd%name(i) = parse_node_get_key (pn_prefix)
	end if
	case ("log_var", "string_var", "alias_var")
	pn_prefix => parse_node_get_sub_ptr (pn_var)
	pn_name => parse_node_get_next_ptr (pn_prefix)
	key = parse_node_get_key (pn_prefix)
	if (associated (pn_name)) then
	select case (char (parse_node_get_rule_key (pn_name)))
	case ("var_name")
	select case (char (key))
	case ("?", "$") ! $ sign
	cmd%name(i) = key // parse_node_get_string (pn_name)
	case ("alias")
	cmd%name(i) = parse_node_get_string (pn_name)
	end select
	case default
	call parse_node_mismatch &
	("var_name", pn_name)
	end select
	else
	cmd%name(i) = key
	end if
	case default
	cmd%name(i) = parse_node_get_string (pn_var)
	end select
	pn_var => parse_node_get_next_ptr (pn_var)
	end do
	else
	allocate (cmd%name (0))
	end if
	end subroutine cmd_show_compile

	@ %def cmd_show_compile
	@ Execute. Scan the list of objects to show.
	<<Commands: parameters>>=
	integer, parameter, public :: SHOW_BUFFER_SIZE = 4096
	<<Commands: cmd show: TBP>>=
	procedure :: execute => cmd_show_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_show_execute (cmd, global)
	class(cmd_show_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_show_execute
	<<Commands: procedures>>=
	module subroutine cmd_show_execute (cmd, global)
	class(cmd_show_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list, model_vars
	type(model_t), pointer :: model
	type(string_t) :: name
	integer :: n, pdg
	type(flavor_t) :: flv
	type(process_library_t), pointer :: prc_lib
	type(process_t), pointer :: process
	logical :: pacified
	character(SHOW_BUFFER_SIZE) :: buffer
	type(string_t) :: out_file
	integer :: i, j, u, u_log, u_out, u_ext
	u = free_unit ()
	var_list => cmd%local%var_list
	if (associated (cmd%local%model)) then
	model_vars => cmd%local%model%get_var_list_ptr ()
	else
	model_vars => null ()
	end if
	pacified = var_list%get_lval (var_str ("?pacify"))
	out_file = var_list%get_sval (var_str ("$out_file"))
	if (file_list_is_open (global%out_files, out_file, action="write")) then
	call msg_message ("show: copying output to file '" &
	// char (out_file) // "'")
	u_ext = file_list_get_unit (global%out_files, out_file)
	else
	u_ext = -1
	end if
	open (u, status = "scratch", action = "readwrite")
	if (associated (cmd%local%model)) then
	name = cmd%local%model%get_name ()
	end if
	if (size (cmd%name) == 0) then
	if (associated (model_vars)) then
	call model_vars%write (model_name = name, &
	unit = u, pacified = pacified, follow_link = .false.)
	end if
	call var_list%write (unit = u, pacified = pacified)
	else
	do i = 1, size (cmd%name)
	select case (char (cmd%name(i)))
	case ("model")
	if (associated (cmd%local%model)) then
	call cmd%local%model%show (u)
	else
	write (u, "(A)") "Model: [undefined]"
	end if
	case ("library")
	if (associated (cmd%local%prclib)) then
	call cmd%local%prclib%show (u)
	else
	write (u, "(A)") "Process library: [undefined]"
	end if
	case ("beams")
	call cmd%local%show_beams (u)
	case ("iterations")
	call cmd%local%it_list%write (u)
	case ("results")
	call cmd%local%process_stack%show (u, fifo=.true.)
	case ("stable")
	call cmd%local%model%show_stable (u)
	case ("polarized")
	call cmd%local%model%show_polarized (u)
	case ("unpolarized")
	call cmd%local%model%show_unpolarized (u)
	case ("unstable")
	model => cmd%local%model
	call model%show_unstable (u)
	n = model%get_n_field ()
	do j = 1, n
	pdg = model%get_pdg (j)
	call flv%init (pdg, model)
	if (.not. flv%is_stable ()) &
	call show_unstable (cmd%local, pdg, u)
	if (flv%has_antiparticle ()) then
	associate (anti => flv%anti ())
	if (.not. anti%is_stable ()) &
	call show_unstable (cmd%local, -pdg, u)
	end associate
	end if
	end do
	case ("cuts", "weight", "scale", &
	"factorization_scale", "renormalization_scale", &
	"selection", "reweight", "analysis")
	call cmd%local%pn%show (cmd%name(i), u)
	case ("expect")
	call expect_summary (force = .true.)
	case ("intrinsic")
	call var_list%write (intrinsic=.true., unit=u, &
	pacified = pacified)
	case ("logical")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_LOG, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (&
	only_type=V_LOG, unit=u, pacified = pacified)
	case ("int")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_INT, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (only_type=V_INT, &
	unit=u, pacified = pacified)
	case ("real")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_REAL, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (only_type=V_REAL, &
	unit=u, pacified = pacified)
	case ("complex")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_CMPLX, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (only_type=V_CMPLX, &
	unit=u, pacified = pacified)
	case ("pdg")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_PDG, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (only_type=V_PDG, &
	unit=u, pacified = pacified)
	case ("string")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_STR, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (only_type=V_STR, &
	unit=u, pacified = pacified)
	case default
	if (analysis_exists (cmd%name(i))) then
	call analysis_write (cmd%name(i), u)
	else if (cmd%local%process_stack%exists (cmd%name(i))) then
	process => cmd%local%process_stack%get_process_ptr (cmd%name(i))
	call process%show (u)
	else if (associated (cmd%local%prclib_stack%get_library_ptr &
	(cmd%name(i)))) then
	prc_lib => cmd%local%prclib_stack%get_library_ptr (cmd%name(i))
	call prc_lib%show (u)
	else if (associated (model_vars)) then
	if (model_vars%contains (cmd%name(i), follow_link=.false.)) then
	call model_vars%write_var (cmd%name(i), &
	unit = u, model_name = name, pacified = pacified)
	else if (var_list%contains (cmd%name(i))) then
	call var_list%write_var (cmd%name(i), &
	unit = u, pacified = pacified)
	else
	call msg_error ("show: object '" // char (cmd%name(i)) &
	// "' not found")
	end if
	else if (var_list%contains (cmd%name(i))) then
	call var_list%write_var (cmd%name(i), &
	unit = u, pacified = pacified)
	else
	call msg_error ("show: object '" // char (cmd%name(i)) &
	// "' not found")
	end if
	end select
	end do
	end if
	rewind (u)
	u_log = logfile_unit ()
	u_out = given_output_unit ()
	do
	read (u, "(A)", end = 1) buffer
	if (u_log > 0) write (u_log, "(A)") trim (buffer)
	if (u_out > 0) write (u_out, "(A)") trim (buffer)
	if (u_ext > 0) write (u_ext, "(A)") trim (buffer)
	end do
	1 close (u)
	if (u_log > 0) flush (u_log)
	if (u_out > 0) flush (u_out)
	if (u_ext > 0) flush (u_ext)
	end subroutine cmd_show_execute

	@ %def cmd_show_execute
	@
	\subsubsection{Clear values}
	This command clears the current values of variables or other objects,
	where this makes sense. It parallels the [[show]] command. The
	objects are cleared, but not deleted.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_clear_t
	private
	type(string_t), dimension(:), allocatable :: name
	contains
	<<Commands: cmd clear: TBP>>
	end type cmd_clear_t

	@ %def cmd_clear_t
	@ Output: list the names of the objects to be cleared.
	<<Commands: cmd clear: TBP>>=
	procedure :: write => cmd_clear_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_clear_write (cmd, unit, indent)
	class(cmd_clear_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_clear_write
	<<Commands: procedures>>=
	module subroutine cmd_clear_write (cmd, unit, indent)
	class(cmd_clear_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "clear: "
	if (allocated (cmd%name)) then
	do i = 1, size (cmd%name)
	write (u, "(1x,A)", advance="no") char (cmd%name(i))
	end do
	write (u, *)
	else
	write (u, "(5x,A)") "[undefined]"
	end if
	end subroutine cmd_clear_write

	@ %def cmd_clear_write
	@ Compile. Allocate an array which is filled with the names of the
	objects to be cleared.

	Note: there is currently no need to account for options, but we
	prepare for that possibility.
	<<Commands: cmd clear: TBP>>=
	procedure :: compile => cmd_clear_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_clear_compile (cmd, global)
	class(cmd_clear_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_clear_compile
	<<Commands: procedures>>=
	module subroutine cmd_clear_compile (cmd, global)
	class(cmd_clear_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
	type(string_t) :: key
	integer :: i, n_args
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (pn_arg)) then
	select case (char (parse_node_get_rule_key (pn_arg)))
	case ("clear_arg")
	cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
	case default
	cmd%pn_opt => pn_arg
	pn_arg => null ()
	end select
	end if
	call cmd%compile_options (global)
	if (associated (pn_arg)) then
	n_args = parse_node_get_n_sub (pn_arg)
	allocate (cmd%name (n_args))
	pn_var => parse_node_get_sub_ptr (pn_arg)
	i = 0
	do while (associated (pn_var))
	i = i + 1
	select case (char (parse_node_get_rule_key (pn_var)))
	case ("beams", "iterations", &
	"cuts", "weight", &
	"scale", "factorization_scale", "renormalization_scale", &
	"selection", "reweight", "analysis", &
	"unstable", "polarized", &
	"expect")
	cmd%name(i) = parse_node_get_key (pn_var)
	case ("log_var", "string_var")
	pn_prefix => parse_node_get_sub_ptr (pn_var)
	pn_name => parse_node_get_next_ptr (pn_prefix)
	key = parse_node_get_key (pn_prefix)
	if (associated (pn_name)) then
	select case (char (parse_node_get_rule_key (pn_name)))
	case ("var_name")
	select case (char (key))
	case ("?", "$") ! $ sign
	cmd%name(i) = key // parse_node_get_string (pn_name)
	end select
	case default
	call parse_node_mismatch &
	("var_name", pn_name)
	end select
	else
	cmd%name(i) = key
	end if
	case default
	cmd%name(i) = parse_node_get_string (pn_var)
	end select
	pn_var => parse_node_get_next_ptr (pn_var)
	end do
	else
	allocate (cmd%name (0))
	end if
	end subroutine cmd_clear_compile

	@ %def cmd_clear_compile
	@ Execute. Scan the list of objects to clear.

	Objects that can be shown but not cleared: model, library, results
	<<Commands: cmd clear: TBP>>=
	procedure :: execute => cmd_clear_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_clear_execute (cmd, global)
	class(cmd_clear_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_clear_execute
	<<Commands: procedures>>=
	module subroutine cmd_clear_execute (cmd, global)
	class(cmd_clear_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	integer :: i
	logical :: success
	type(var_list_t), pointer :: model_vars
	if (size (cmd%name) == 0) then
	call msg_warning ("clear: no object specified")
	else
	do i = 1, size (cmd%name)
	success = .true.
	select case (char (cmd%name(i)))
	case ("beams")
	call cmd%local%clear_beams ()
	case ("iterations")
	call cmd%local%it_list%clear ()
	case ("polarized")
	call cmd%local%model%clear_polarized ()
	case ("unstable")
	call cmd%local%model%clear_unstable ()
	case ("cuts", "weight", "scale", &
	"factorization_scale", "renormalization_scale", &
	"selection", "reweight", "analysis")
	call cmd%local%pn%clear (cmd%name(i))
	case ("expect")
	call expect_clear ()
	case default
	if (analysis_exists (cmd%name(i))) then
	call analysis_clear (cmd%name(i))
	else if (cmd%local%var_list%contains (cmd%name(i))) then
	if (.not. cmd%local%var_list%is_locked (cmd%name(i))) then
	call cmd%local%var_list%unset (cmd%name(i))
	else
	call msg_error ("clear: variable '" // char (cmd%name(i)) &
	// "' is locked and can't be cleared")
	success = .false.
	end if
	else if (associated (cmd%local%model)) then
	model_vars => cmd%local%model%get_var_list_ptr ()
	if (model_vars%contains (cmd%name(i), follow_link=.false.)) then
	call msg_error ("clear: variable '" // char (cmd%name(i)) &
	// "' is a model variable and can't be cleared")
	else
	call msg_error ("clear: object '" // char (cmd%name(i)) &
	// "' not found")
	end if
	success = .false.
	else
	call msg_error ("clear: object '" // char (cmd%name(i)) &
	// "' not found")
	success = .false.
	end if
	end select
	if (success) call msg_message ("cleared: " // char (cmd%name(i)))
	end do
	end if
	end subroutine cmd_clear_execute

	@ %def cmd_clear_execute
	@
	\subsubsection{Compare values of variables to expectation}
	The implementation is similar to the [[show]] command. There are just
	two arguments: two values that should be compared. For providing
	local values for the numerical tolerance, the command has a local
	argument list.

	If the expectation fails, an error condition is recorded.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_expect_t
	private
	type(parse_node_t), pointer :: pn_lexpr => null ()
	contains
	<<Commands: cmd expect: TBP>>
	end type cmd_expect_t

	@ %def cmd_expect_t
	@ Simply tell the status.
	<<Commands: cmd expect: TBP>>=
	procedure :: write => cmd_expect_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_expect_write (cmd, unit, indent)
	class(cmd_expect_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_expect_write
	<<Commands: procedures>>=
	module subroutine cmd_expect_write (cmd, unit, indent)
	class(cmd_expect_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	if (associated (cmd%pn_lexpr)) then
	write (u, "(1x,A)") "expect: [expression associated]"
	else
	write (u, "(1x,A)") "expect: [undefined]"
	end if
	end subroutine cmd_expect_write

	@ %def cmd_expect_write
	@ Compile. This merely assigns the parse node, the actual compilation is done
	at execution. This is necessary because the origin of variables
	(local/global) may change during execution.
	<<Commands: cmd expect: TBP>>=
	procedure :: compile => cmd_expect_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_expect_compile (cmd, global)
	class(cmd_expect_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_expect_compile
	<<Commands: procedures>>=
	module subroutine cmd_expect_compile (cmd, global)
	class(cmd_expect_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
	cmd%pn_lexpr => parse_node_get_sub_ptr (pn_arg)
	call cmd%compile_options (global)
	end subroutine cmd_expect_compile

	@ %def cmd_expect_compile
	@ Execute. Evaluate both arguments, print them and their difference
	(if numerical), and whether they agree. Record the result.
	<<Commands: cmd expect: TBP>>=
	procedure :: execute => cmd_expect_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_expect_execute (cmd, global)
	class(cmd_expect_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_expect_execute
	<<Commands: procedures>>=
	module subroutine cmd_expect_execute (cmd, global)
	class(cmd_expect_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	logical :: success, is_known
	var_list => cmd%local%get_var_list_ptr ()
	success = eval_log (cmd%pn_lexpr, var_list, is_known=is_known)
	if (is_known) then
	if (success) then
	call msg_message ("expect: success")
	else
	call msg_error ("expect: failure")
	end if
	else
	call msg_error ("expect: undefined result")
	success = .false.
	end if
	call expect_record (success)
	end subroutine cmd_expect_execute

	@ %def cmd_expect_execute
	@
	\subsubsection{Beams}
	The beam command includes both beam and structure-function
	definition.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_beams_t
	private
	integer :: n_in = 0
	type(parse_node_p), dimension(:), allocatable :: pn_pdg
	integer :: n_sf_record = 0
	integer, dimension(:), allocatable :: n_entry
	type(parse_node_p), dimension(:,:), allocatable :: pn_sf_entry
	contains
	<<Commands: cmd beams: TBP>>
	end type cmd_beams_t

	@ %def cmd_beams_t
	@ Output. The particle expressions are not resolved.
	<<Commands: cmd beams: TBP>>=
	procedure :: write => cmd_beams_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_write (cmd, unit, indent)
	class(cmd_beams_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_beams_write
	<<Commands: procedures>>=
	module subroutine cmd_beams_write (cmd, unit, indent)
	class(cmd_beams_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams: [undefined]"
	end select
	if (allocated (cmd%n_entry)) then
	if (cmd%n_sf_record > 0) then
	write (u, "(1x,A,99(1x,I0))") "structure function entries:", &
	cmd%n_entry
	end if
	end if
	end subroutine cmd_beams_write

	@ %def cmd_beams_write
	@ Compile. Find and assign the parse nodes.

	Note: local environments are not yet supported.
	<<Commands: cmd beams: TBP>>=
	procedure :: compile => cmd_beams_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_compile (cmd, global)
	class(cmd_beams_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_beams_compile
	<<Commands: procedures>>=
	module subroutine cmd_beams_compile (cmd, global)
	class(cmd_beams_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_beam_def, pn_beam_spec
	type(parse_node_t), pointer :: pn_beam_list
	type(parse_node_t), pointer :: pn_codes
	type(parse_node_t), pointer :: pn_strfun_seq, pn_strfun_pair
	type(parse_node_t), pointer :: pn_strfun_def
	integer :: i
	pn_beam_def => parse_node_get_sub_ptr (cmd%pn, 3)
	pn_beam_spec => parse_node_get_sub_ptr (pn_beam_def)
	pn_strfun_seq => parse_node_get_next_ptr (pn_beam_spec)
	pn_beam_list => parse_node_get_sub_ptr (pn_beam_spec)
	call cmd%compile_options (global)
	cmd%n_in = parse_node_get_n_sub (pn_beam_list)
	allocate (cmd%pn_pdg (cmd%n_in))
	pn_codes => parse_node_get_sub_ptr (pn_beam_list)
	do i = 1, cmd%n_in
	cmd%pn_pdg(i)%ptr => pn_codes
	pn_codes => parse_node_get_next_ptr (pn_codes)
	end do
	if (associated (pn_strfun_seq)) then
	cmd%n_sf_record = parse_node_get_n_sub (pn_beam_def) - 1
	allocate (cmd%n_entry (cmd%n_sf_record), source = 1)
	allocate (cmd%pn_sf_entry (2, cmd%n_sf_record))
	do i = 1, cmd%n_sf_record
	pn_strfun_pair => parse_node_get_sub_ptr (pn_strfun_seq, 2)
	pn_strfun_def => parse_node_get_sub_ptr (pn_strfun_pair)
	cmd%pn_sf_entry(1,i)%ptr => pn_strfun_def
	pn_strfun_def => parse_node_get_next_ptr (pn_strfun_def)
	cmd%pn_sf_entry(2,i)%ptr => pn_strfun_def
	if (associated (pn_strfun_def)) cmd%n_entry(i) = 2
	pn_strfun_seq => parse_node_get_next_ptr (pn_strfun_seq)
	end do
	else
	allocate (cmd%n_entry (0))
	allocate (cmd%pn_sf_entry (0, 0))
	end if
	end subroutine cmd_beams_compile

	@ %def cmd_beams_compile
	@ Command execution: Determine beam particles and structure-function
	names, if any. The results are stored in the [[beam_structure]]
	component of the [[global]] data block.
	<<Commands: cmd beams: TBP>>=
	procedure :: execute => cmd_beams_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_execute (cmd, global)
	class(cmd_beams_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_beams_execute
	<<Commands: procedures>>=
	module subroutine cmd_beams_execute (cmd, global)
	class(cmd_beams_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(pdg_array_t) :: pdg_array
	integer, dimension(:), allocatable :: pdg
	type(flavor_t), dimension(:), allocatable :: flv
	type(parse_node_t), pointer :: pn_key
	type(string_t) :: sf_name
	integer :: i, j
	call lhapdf_global_reset ()
	var_list => cmd%local%get_var_list_ptr ()
	allocate (flv (cmd%n_in))
	do i = 1, cmd%n_in
	pdg_array = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
	pdg = pdg_array
	select case (size (pdg))
	case (1)
	call flv(i)%init ( pdg(1), cmd%local%model)
	case default
	call msg_fatal ("Beams: beam particles must be unique")
	end select
	end do
	select case (cmd%n_in)
	case (1)
	if (cmd%n_sf_record > 0) then
	call msg_fatal ("Beam setup: no structure functions allowed &
	&for decay")
	end if
	call global%beam_structure%init_sf (flv%get_name ())
	case (2)
	call global%beam_structure%init_sf (flv%get_name (), cmd%n_entry)
	do i = 1, cmd%n_sf_record
	do j = 1, cmd%n_entry(i)
	pn_key => parse_node_get_sub_ptr (cmd%pn_sf_entry(j,i)%ptr)
	sf_name = parse_node_get_key (pn_key)
	call global%beam_structure%set_sf (i, j, sf_name)
	end do
	end do
	end select
	end subroutine cmd_beams_execute

	@ %def cmd_beams_execute
	@
	\subsubsection{Density matrices for beam polarization}
	For holding beam polarization, we define a notation and a data
	structure for sparse matrices. The entries (and the index
	expressions) are numerical expressions, so we use evaluation trees.

	Each entry in the sparse matrix is an n-tuple of expressions. The first
	tuple elements represent index values, the last one is an arbitrary
	(complex) number. Absent expressions are replaced by default-value rules.

	Note: Here, and in some other commands, we would like to store an evaluation
	tree, not just a parse node pointer. However, the current expression handler
	wants all variables defined, so the evaluation tree can only be built by
	[[evaluate]], i.e., compiled just-in-time and evaluated immediately.
	<<Commands: types>>=
	type :: sentry_expr_t
	type(parse_node_p), dimension(:), allocatable :: expr
	contains
	<<Commands: sentry expr: TBP>>
	end type sentry_expr_t

	@ %def sentry_expr_t
	@ Compile parse nodes into evaluation trees.
	<<Commands: sentry expr: TBP>>=
	procedure :: compile => sentry_expr_compile
	<<Commands: sub interfaces>>=
	module subroutine sentry_expr_compile (sentry, pn)
	class(sentry_expr_t), intent(out) :: sentry
	type(parse_node_t), intent(in), target :: pn
	end subroutine sentry_expr_compile
	<<Commands: procedures>>=
	module subroutine sentry_expr_compile (sentry, pn)
	class(sentry_expr_t), intent(out) :: sentry
	type(parse_node_t), intent(in), target :: pn
	type(parse_node_t), pointer :: pn_expr, pn_extra
	integer :: n_expr, i
	n_expr = parse_node_get_n_sub (pn)
	allocate (sentry%expr (n_expr))
	if (n_expr > 0) then
	i = 0
	pn_expr => parse_node_get_sub_ptr (pn)
	pn_extra => parse_node_get_next_ptr (pn_expr)
	do i = 1, n_expr
	sentry%expr(i)%ptr => pn_expr
	if (associated (pn_extra)) then
	pn_expr => parse_node_get_sub_ptr (pn_extra, 2)
	pn_extra => parse_node_get_next_ptr (pn_extra)
	end if
	end do
	end if
	end subroutine sentry_expr_compile

	@ %def sentry_expr_compile
	@ Evaluate the expressions and return an index array of predefined
	length together with a complex value. If the value (as the last expression)
	is undefined, set it to unity. If index values are undefined, repeat
	the previous index value.
	<<Commands: sentry expr: TBP>>=
	procedure :: evaluate => sentry_expr_evaluate
	<<Commands: sub interfaces>>=
	module subroutine sentry_expr_evaluate (sentry, index, value, global)
	class(sentry_expr_t), intent(inout) :: sentry
	integer, dimension(:), intent(out) :: index
	complex(default), intent(out) :: value
	type(rt_data_t), intent(in), target :: global
	end subroutine sentry_expr_evaluate
	<<Commands: procedures>>=
	module subroutine sentry_expr_evaluate (sentry, index, value, global)
	class(sentry_expr_t), intent(inout) :: sentry
	integer, dimension(:), intent(out) :: index
	complex(default), intent(out) :: value
	type(rt_data_t), intent(in), target :: global
	type(var_list_t), pointer :: var_list
	integer :: i, n_expr, n_index
	type(eval_tree_t) :: eval_tree
	var_list => global%get_var_list_ptr ()
	n_expr = size (sentry%expr)
	n_index = size (index)
	if (n_expr <= n_index + 1) then
	do i = 1, min (n_expr, n_index)
	associate (expr => sentry%expr(i))
	call eval_tree%init_expr (expr%ptr, var_list)
	call eval_tree%evaluate ()
	if (eval_tree%is_known ()) then
	index(i) = eval_tree%get_int ()
	else
	call msg_fatal ("Evaluating density matrix: undefined index")
	end if
	end associate
	end do
	do i = n_expr + 1, n_index
	index(i) = index(n_expr)
	end do
	if (n_expr == n_index + 1) then
	associate (expr => sentry%expr(n_expr))
	call eval_tree%init_expr (expr%ptr, var_list)
	call eval_tree%evaluate ()
	if (eval_tree%is_known ()) then
	value = eval_tree%get_cmplx ()
	else
	call msg_fatal ("Evaluating density matrix: undefined index")
	end if
	call eval_tree%final ()
	end associate
	else
	value = 1
	end if
	else
	call msg_fatal ("Evaluating density matrix: index expression too long")
	end if
	end subroutine sentry_expr_evaluate

	@ %def sentry_expr_evaluate
	@ The sparse matrix itself consists of an arbitrary number of entries.
	<<Commands: types>>=
	type :: smatrix_expr_t
	type(sentry_expr_t), dimension(:), allocatable :: entry
	contains
	<<Commands: smatrix expr: TBP>>
	end type smatrix_expr_t

	@ %def smatrix_expr_t
	@ Compile: assign sub-nodes to sentry-expressions and compile those.
	<<Commands: smatrix expr: TBP>>=
	procedure :: compile => smatrix_expr_compile
	<<Commands: sub interfaces>>=
	module subroutine smatrix_expr_compile (smatrix_expr, pn)
	class(smatrix_expr_t), intent(out) :: smatrix_expr
	type(parse_node_t), intent(in), target :: pn
	end subroutine smatrix_expr_compile
	<<Commands: procedures>>=
	module subroutine smatrix_expr_compile (smatrix_expr, pn)
	class(smatrix_expr_t), intent(out) :: smatrix_expr
	type(parse_node_t), intent(in), target :: pn
	type(parse_node_t), pointer :: pn_arg, pn_entry
	integer :: n_entry, i
	pn_arg => parse_node_get_sub_ptr (pn, 2)
	if (associated (pn_arg)) then
	n_entry = parse_node_get_n_sub (pn_arg)
	allocate (smatrix_expr%entry (n_entry))
	pn_entry => parse_node_get_sub_ptr (pn_arg)
	do i = 1, n_entry
	call smatrix_expr%entry(i)%compile (pn_entry)
	pn_entry => parse_node_get_next_ptr (pn_entry)
	end do
	else
	allocate (smatrix_expr%entry (0))
	end if
	end subroutine smatrix_expr_compile

	@ %def smatrix_expr_compile
	@ Evaluate the entries and build a new [[smatrix]] object, which
	contains just the numerical results.
	<<Commands: smatrix expr: TBP>>=
	procedure :: evaluate => smatrix_expr_evaluate
	<<Commands: sub interfaces>>=
	module subroutine smatrix_expr_evaluate (smatrix_expr, smatrix, global)
	class(smatrix_expr_t), intent(inout) :: smatrix_expr
	type(smatrix_t), intent(out) :: smatrix
	type(rt_data_t), intent(in), target :: global
	end subroutine smatrix_expr_evaluate
	<<Commands: procedures>>=
	module subroutine smatrix_expr_evaluate (smatrix_expr, smatrix, global)
	class(smatrix_expr_t), intent(inout) :: smatrix_expr
	type(smatrix_t), intent(out) :: smatrix
	type(rt_data_t), intent(in), target :: global
	integer, dimension(2) :: idx
	complex(default) :: value
	integer :: i, n_entry
	n_entry = size (smatrix_expr%entry)
	call smatrix%init (2, n_entry)
	do i = 1, n_entry
	call smatrix_expr%entry(i)%evaluate (idx, value, global)
	call smatrix%set_entry (i, idx, value)
	end do
	end subroutine smatrix_expr_evaluate

	@ %def smatrix_expr_evaluate
	@
	\subsubsection{Beam polarization density}

	The beam polarization command defines spin density matrix for one or
	two beams (scattering or decay).
	<<Commands: types>>=
	type, extends (command_t) :: cmd_beams_pol_density_t
	private
	integer :: n_in = 0
	type(smatrix_expr_t), dimension(:), allocatable :: smatrix
	contains
	<<Commands: cmd beams pol density: TBP>>
	end type cmd_beams_pol_density_t

	@ %def cmd_beams_pol_density_t
	@ Output.
	<<Commands: cmd beams pol density: TBP>>=
	procedure :: write => cmd_beams_pol_density_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_pol_density_write (cmd, unit, indent)
	class(cmd_beams_pol_density_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_beams_pol_density_write
	<<Commands: procedures>>=
	module subroutine cmd_beams_pol_density_write (cmd, unit, indent)
	class(cmd_beams_pol_density_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams polarization setup: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams polarization setup: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams polarization setup: [undefined]"
	end select
	end subroutine cmd_beams_pol_density_write

	@ %def cmd_beams_pol_density_write
	@ Compile. Find and assign the parse nodes.

	Note: local environments are not yet supported.
	<<Commands: cmd beams pol density: TBP>>=
	procedure :: compile => cmd_beams_pol_density_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_pol_density_compile (cmd, global)
	class(cmd_beams_pol_density_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_beams_pol_density_compile
	<<Commands: procedures>>=
	module subroutine cmd_beams_pol_density_compile (cmd, global)
	class(cmd_beams_pol_density_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_pol_spec, pn_smatrix
	integer :: i
	pn_pol_spec => parse_node_get_sub_ptr (cmd%pn, 3)
	call cmd%compile_options (global)
	cmd%n_in = parse_node_get_n_sub (pn_pol_spec)
	allocate (cmd%smatrix (cmd%n_in))
	pn_smatrix => parse_node_get_sub_ptr (pn_pol_spec)
	do i = 1, cmd%n_in
	call cmd%smatrix(i)%compile (pn_smatrix)
	pn_smatrix => parse_node_get_next_ptr (pn_smatrix)
	end do
	end subroutine cmd_beams_pol_density_compile

	@ %def cmd_beams_pol_density_compile
	@ Command execution: Fill polarization density matrices. No check
	yet, the matrices are checked and normalized when the actual beam
	object is created, just before integration. For intermediate storage,
	we use the [[beam_structure]] object in the [[global]] data set.
	<<Commands: cmd beams pol density: TBP>>=
	procedure :: execute => cmd_beams_pol_density_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_pol_density_execute (cmd, global)
	class(cmd_beams_pol_density_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_beams_pol_density_execute
	<<Commands: procedures>>=
	module subroutine cmd_beams_pol_density_execute (cmd, global)
	class(cmd_beams_pol_density_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(smatrix_t) :: smatrix
	integer :: i
	call global%beam_structure%init_pol (cmd%n_in)
	do i = 1, cmd%n_in
	call cmd%smatrix(i)%evaluate (smatrix, global)
	call global%beam_structure%set_smatrix (i, smatrix)
	end do
	end subroutine cmd_beams_pol_density_execute

	@ %def cmd_beams_pol_density_execute
	@
	\subsubsection{Beam polarization fraction}
	In addition to the polarization density matrix, we can independently
	specify the polarization fraction for one or both beams.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_beams_pol_fraction_t
	private
	integer :: n_in = 0
	type(parse_node_p), dimension(:), allocatable :: expr
	contains
	<<Commands: cmd beams pol fraction: TBP>>
	end type cmd_beams_pol_fraction_t

	@ %def cmd_beams_pol_fraction_t
	@ Output.
	<<Commands: cmd beams pol fraction: TBP>>=
	procedure :: write => cmd_beams_pol_fraction_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_pol_fraction_write (cmd, unit, indent)
	class(cmd_beams_pol_fraction_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_beams_pol_fraction_write
	<<Commands: procedures>>=
	module subroutine cmd_beams_pol_fraction_write (cmd, unit, indent)
	class(cmd_beams_pol_fraction_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams polarization fraction: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams polarization fraction: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams polarization fraction: [undefined]"
	end select
	end subroutine cmd_beams_pol_fraction_write

	@ %def cmd_beams_pol_fraction_write
	@ Compile. Find and assign the parse nodes.

	Note: local environments are not yet supported.
	<<Commands: cmd beams pol fraction: TBP>>=
	procedure :: compile => cmd_beams_pol_fraction_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_pol_fraction_compile (cmd, global)
	class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_beams_pol_fraction_compile
	<<Commands: procedures>>=
	module subroutine cmd_beams_pol_fraction_compile (cmd, global)
	class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_frac_spec, pn_expr
	integer :: i
	pn_frac_spec => parse_node_get_sub_ptr (cmd%pn, 3)
	call cmd%compile_options (global)
	cmd%n_in = parse_node_get_n_sub (pn_frac_spec)
	allocate (cmd%expr (cmd%n_in))
	pn_expr => parse_node_get_sub_ptr (pn_frac_spec)
	do i = 1, cmd%n_in
	cmd%expr(i)%ptr => pn_expr
	pn_expr => parse_node_get_next_ptr (pn_expr)
	end do
	end subroutine cmd_beams_pol_fraction_compile

	@ %def cmd_beams_pol_fraction_compile
	@ Command execution: Retrieve the numerical values of the beam
	polarization fractions. The results are stored in the
	[[beam_structure]] component of the [[global]] data block.
	<<Commands: cmd beams pol fraction: TBP>>=
	procedure :: execute => cmd_beams_pol_fraction_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_pol_fraction_execute (cmd, global)
	class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_beams_pol_fraction_execute
	<<Commands: procedures>>=
	module subroutine cmd_beams_pol_fraction_execute (cmd, global)
	class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default), dimension(:), allocatable :: pol_f
	type(eval_tree_t) :: expr
	integer :: i
	var_list => global%get_var_list_ptr ()
	allocate (pol_f (cmd%n_in))
	do i = 1, cmd%n_in
	call expr%init_expr (cmd%expr(i)%ptr, var_list)
	call expr%evaluate ()
	if (expr%is_known ()) then
	pol_f(i) = expr%get_real ()
	else
	call msg_fatal ("beams polarization fraction: undefined value")
	end if
	call expr%final ()
	end do
	call global%beam_structure%set_pol_f (pol_f)
	end subroutine cmd_beams_pol_fraction_execute

	@ %def cmd_beams_pol_fraction_execute
	@
	\subsubsection{Beam momentum}
	This is completely analogous to the previous command, hence we can use
	inheritance.
	<<Commands: types>>=
	type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_momentum_t
	contains
	<<Commands: cmd beams momentum: TBP>>
	end type cmd_beams_momentum_t

	@ %def cmd_beams_momentum_t
	@ Output.
	<<Commands: cmd beams momentum: TBP>>=
	procedure :: write => cmd_beams_momentum_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_momentum_write (cmd, unit, indent)
	class(cmd_beams_momentum_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_beams_momentum_write
	<<Commands: procedures>>=
	module subroutine cmd_beams_momentum_write (cmd, unit, indent)
	class(cmd_beams_momentum_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams momentum: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams momentum: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams momentum: [undefined]"
	end select
	end subroutine cmd_beams_momentum_write

	@ %def cmd_beams_momentum_write
	@ Compile: inherited.

	Command execution: Not inherited, but just the error string and the final
	command are changed.
	<<Commands: cmd beams momentum: TBP>>=
	procedure :: execute => cmd_beams_momentum_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_momentum_execute (cmd, global)
	class(cmd_beams_momentum_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_beams_momentum_execute
	<<Commands: procedures>>=
	module subroutine cmd_beams_momentum_execute (cmd, global)
	class(cmd_beams_momentum_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default), dimension(:), allocatable :: p
	type(eval_tree_t) :: expr
	integer :: i
	var_list => global%get_var_list_ptr ()
	allocate (p (cmd%n_in))
	do i = 1, cmd%n_in
	call expr%init_expr (cmd%expr(i)%ptr, var_list)
	call expr%evaluate ()
	if (expr%is_known ()) then
	p(i) = expr%get_real ()
	else
	call msg_fatal ("beams momentum: undefined value")
	end if
	call expr%final ()
	end do
	call global%beam_structure%set_momentum (p)
	end subroutine cmd_beams_momentum_execute

	@ %def cmd_beams_momentum_execute
	@
	\subsubsection{Beam angles}
	Again, this is analogous. There are two angles, polar angle $\theta$
	and azimuthal angle $\phi$, which can be set independently for both beams.
	<<Commands: types>>=
	type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_theta_t
	contains
	<<Commands: cmd beams theta: TBP>>
	end type cmd_beams_theta_t

	type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_phi_t
	contains
	<<Commands: cmd beams phi: TBP>>
	end type cmd_beams_phi_t

	@ %def cmd_beams_theta_t
	@ %def cmd_beams_phi_t
	@ Output.
	<<Commands: cmd beams theta: TBP>>=
	procedure :: write => cmd_beams_theta_write
	<<Commands: cmd beams phi: TBP>>=
	procedure :: write => cmd_beams_phi_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_theta_write (cmd, unit, indent)
	class(cmd_beams_theta_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_beams_theta_write
	module subroutine cmd_beams_phi_write (cmd, unit, indent)
	class(cmd_beams_phi_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_beams_phi_write
	<<Commands: procedures>>=
	module subroutine cmd_beams_theta_write (cmd, unit, indent)
	class(cmd_beams_theta_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams theta: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams theta: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams theta: [undefined]"
	end select
	end subroutine cmd_beams_theta_write

	module subroutine cmd_beams_phi_write (cmd, unit, indent)
	class(cmd_beams_phi_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams phi: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams phi: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams phi: [undefined]"
	end select
	end subroutine cmd_beams_phi_write

	@ %def cmd_beams_theta_write
	@ %def cmd_beams_phi_write
	@ Compile: inherited.

	Command execution: Not inherited, but just the error string and the final
	command are changed.
	<<Commands: cmd beams theta: TBP>>=
	procedure :: execute => cmd_beams_theta_execute
	<<Commands: cmd beams phi: TBP>>=
	procedure :: execute => cmd_beams_phi_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_beams_theta_execute (cmd, global)
	class(cmd_beams_theta_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_beams_theta_execute
	module subroutine cmd_beams_phi_execute (cmd, global)
	class(cmd_beams_phi_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_beams_phi_execute
	<<Commands: procedures>>=
	module subroutine cmd_beams_theta_execute (cmd, global)
	class(cmd_beams_theta_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default), dimension(:), allocatable :: theta
	type(eval_tree_t) :: expr
	integer :: i
	var_list => global%get_var_list_ptr ()
	allocate (theta (cmd%n_in))
	do i = 1, cmd%n_in
	call expr%init_expr (cmd%expr(i)%ptr, var_list)
	call expr%evaluate ()
	if (expr%is_known ()) then
	theta(i) = expr%get_real ()
	else
	call msg_fatal ("beams theta: undefined value")
	end if
	call expr%final ()
	end do
	call global%beam_structure%set_theta (theta)
	end subroutine cmd_beams_theta_execute

	module subroutine cmd_beams_phi_execute (cmd, global)
	class(cmd_beams_phi_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default), dimension(:), allocatable :: phi
	type(eval_tree_t) :: expr
	integer :: i
	var_list => global%get_var_list_ptr ()
	allocate (phi (cmd%n_in))
	do i = 1, cmd%n_in
	call expr%init_expr (cmd%expr(i)%ptr, var_list)
	call expr%evaluate ()
	if (expr%is_known ()) then
	phi(i) = expr%get_real ()
	else
	call msg_fatal ("beams phi: undefined value")
	end if
	call expr%final ()
	end do
	call global%beam_structure%set_phi (phi)
	end subroutine cmd_beams_phi_execute

	@ %def cmd_beams_theta_execute
	@ %def cmd_beams_phi_execute
	@
	\subsubsection{Cuts}
	Define a cut expression. We store the parse tree for the right-hand
	side instead of compiling it. Compilation is deferred to the process
	environment where the cut expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_cuts_t
	private
	type(parse_node_t), pointer :: pn_lexpr => null ()
	contains
	<<Commands: cmd cuts: TBP>>
	end type cmd_cuts_t

	@ %def cmd_cuts_t
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that cuts have been defined.
	<<Commands: cmd cuts: TBP>>=
	procedure :: write => cmd_cuts_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_cuts_write (cmd, unit, indent)
	class(cmd_cuts_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_cuts_write
	<<Commands: procedures>>=
	module subroutine cmd_cuts_write (cmd, unit, indent)
	class(cmd_cuts_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "cuts: [defined]"
	end subroutine cmd_cuts_write

	@ %def cmd_cuts_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd cuts: TBP>>=
	procedure :: compile => cmd_cuts_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_cuts_compile (cmd, global)
	class(cmd_cuts_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_cuts_compile
	<<Commands: procedures>>=
	module subroutine cmd_cuts_compile (cmd, global)
	class(cmd_cuts_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_cuts_compile

	@ %def cmd_cuts_compile
	@ Instead of evaluating the cut expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd cuts: TBP>>=
	procedure :: execute => cmd_cuts_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_cuts_execute (cmd, global)
	class(cmd_cuts_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_cuts_execute
	<<Commands: procedures>>=
	module subroutine cmd_cuts_execute (cmd, global)
	class(cmd_cuts_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%cuts_lexpr => cmd%pn_lexpr
	end subroutine cmd_cuts_execute

	@ %def cmd_cuts_execute
	@
	\subsubsection{General, Factorization and Renormalization Scales}
	Define a scale expression for either the renormalization or the
	factorization scale. We store the parse tree for the right-hand
	side instead of compiling it. Compilation is deferred to the process
	environment where the expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_scale_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd scale: TBP>>
	end type cmd_scale_t

	@ %def cmd_scale_t
	<<Commands: types>>=
	type, extends (command_t) :: cmd_fac_scale_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd fac scale: TBP>>
	end type cmd_fac_scale_t

	@ %def cmd_fac_scale_t
	<<Commands: types>>=
	type, extends (command_t) :: cmd_ren_scale_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd ren scale: TBP>>
	end type cmd_ren_scale_t

	@ %def cmd_ren_scale_t
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that scale, renormalization and factorization have been
	defined, respectively.
	<<Commands: cmd scale: TBP>>=
	procedure :: write => cmd_scale_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_scale_write (cmd, unit, indent)
	class(cmd_scale_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_scale_write
	<<Commands: procedures>>=
	module subroutine cmd_scale_write (cmd, unit, indent)
	class(cmd_scale_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "scale: [defined]"
	end subroutine cmd_scale_write

	@ %def cmd_scale_write
	@
	<<Commands: cmd fac scale: TBP>>=
	procedure :: write => cmd_fac_scale_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_fac_scale_write (cmd, unit, indent)
	class(cmd_fac_scale_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_fac_scale_write
	<<Commands: procedures>>=
	module subroutine cmd_fac_scale_write (cmd, unit, indent)
	class(cmd_fac_scale_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "factorization scale: [defined]"
	end subroutine cmd_fac_scale_write

	@ %def cmd_fac_scale_write
	@
	<<Commands: cmd ren scale: TBP>>=
	procedure :: write => cmd_ren_scale_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_ren_scale_write (cmd, unit, indent)
	class(cmd_ren_scale_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_ren_scale_write
	<<Commands: procedures>>=
	module subroutine cmd_ren_scale_write (cmd, unit, indent)
	class(cmd_ren_scale_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "renormalization scale: [defined]"
	end subroutine cmd_ren_scale_write

	@ %def cmd_ren_scale_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd scale: TBP>>=
	procedure :: compile => cmd_scale_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_scale_compile (cmd, global)
	class(cmd_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_scale_compile
	<<Commands: procedures>>=
	module subroutine cmd_scale_compile (cmd, global)
	class(cmd_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_scale_compile

	@ %def cmd_scale_compile
	@
	<<Commands: cmd fac scale: TBP>>=
	procedure :: compile => cmd_fac_scale_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_fac_scale_compile (cmd, global)
	class(cmd_fac_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_fac_scale_compile
	<<Commands: procedures>>=
	module subroutine cmd_fac_scale_compile (cmd, global)
	class(cmd_fac_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_fac_scale_compile

	@ %def cmd_fac_scale_compile
	@
	<<Commands: cmd ren scale: TBP>>=
	procedure :: compile => cmd_ren_scale_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_ren_scale_compile (cmd, global)
	class(cmd_ren_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_ren_scale_compile
	<<Commands: procedures>>=
	module subroutine cmd_ren_scale_compile (cmd, global)
	class(cmd_ren_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_ren_scale_compile

	@ %def cmd_ren_scale_compile
	@ Instead of evaluating the scale expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd scale: TBP>>=
	procedure :: execute => cmd_scale_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_scale_execute (cmd, global)
	class(cmd_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_scale_execute
	<<Commands: procedures>>=
	module subroutine cmd_scale_execute (cmd, global)
	class(cmd_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%scale_expr => cmd%pn_expr
	end subroutine cmd_scale_execute

	@ %def cmd_scale_execute
	@
	<<Commands: cmd fac scale: TBP>>=
	procedure :: execute => cmd_fac_scale_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_fac_scale_execute (cmd, global)
	class(cmd_fac_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_fac_scale_execute
	<<Commands: procedures>>=
	module subroutine cmd_fac_scale_execute (cmd, global)
	class(cmd_fac_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%fac_scale_expr => cmd%pn_expr
	end subroutine cmd_fac_scale_execute

	@ %def cmd_fac_scale_execute
	@
	<<Commands: cmd ren scale: TBP>>=
	procedure :: execute => cmd_ren_scale_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_ren_scale_execute (cmd, global)
	class(cmd_ren_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_ren_scale_execute
	<<Commands: procedures>>=
	module subroutine cmd_ren_scale_execute (cmd, global)
	class(cmd_ren_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%ren_scale_expr => cmd%pn_expr
	end subroutine cmd_ren_scale_execute

	@ %def cmd_ren_scale_execute
	@
	\subsubsection{Weight}
	Define a weight expression. The weight is applied to a process to be
	integrated, event by event. We store the parse tree for the right-hand
	side instead of compiling it. Compilation is deferred to the process
	environment where the expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_weight_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd weight: TBP>>
	end type cmd_weight_t

	@ %def cmd_weight_t
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that scale, renormalization and factorization have been
	defined, respectively.
	<<Commands: cmd weight: TBP>>=
	procedure :: write => cmd_weight_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_weight_write (cmd, unit, indent)
	class(cmd_weight_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_weight_write
	<<Commands: procedures>>=
	module subroutine cmd_weight_write (cmd, unit, indent)
	class(cmd_weight_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "weight expression: [defined]"
	end subroutine cmd_weight_write

	@ %def cmd_weight_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd weight: TBP>>=
	procedure :: compile => cmd_weight_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_weight_compile (cmd, global)
	class(cmd_weight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_weight_compile
	<<Commands: procedures>>=
	module subroutine cmd_weight_compile (cmd, global)
	class(cmd_weight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_weight_compile

	@ %def cmd_weight_compile
	@ Instead of evaluating the expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd weight: TBP>>=
	procedure :: execute => cmd_weight_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_weight_execute (cmd, global)
	class(cmd_weight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_weight_execute
	<<Commands: procedures>>=
	module subroutine cmd_weight_execute (cmd, global)
	class(cmd_weight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%weight_expr => cmd%pn_expr
	end subroutine cmd_weight_execute

	@ %def cmd_weight_execute
	@
	\subsubsection{Selection}
	Define a selection expression. This is to be applied upon simulation or
	event-file rescanning, event by event. We store the parse tree for the
	right-hand side instead of compiling it. Compilation is deferred to the
	environment where the expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_selection_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd selection: TBP>>
	end type cmd_selection_t

	@ %def cmd_selection_t
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that scale, renormalization and factorization have been
	defined, respectively.
	<<Commands: cmd selection: TBP>>=
	procedure :: write => cmd_selection_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_selection_write (cmd, unit, indent)
	class(cmd_selection_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_selection_write
	<<Commands: procedures>>=
	module subroutine cmd_selection_write (cmd, unit, indent)
	class(cmd_selection_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "selection expression: [defined]"
	end subroutine cmd_selection_write

	@ %def cmd_selection_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd selection: TBP>>=
	procedure :: compile => cmd_selection_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_selection_compile (cmd, global)
	class(cmd_selection_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_selection_compile
	<<Commands: procedures>>=
	module subroutine cmd_selection_compile (cmd, global)
	class(cmd_selection_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_selection_compile

	@ %def cmd_selection_compile
	@ Instead of evaluating the expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd selection: TBP>>=
	procedure :: execute => cmd_selection_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_selection_execute (cmd, global)
	class(cmd_selection_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_selection_execute
	<<Commands: procedures>>=
	module subroutine cmd_selection_execute (cmd, global)
	class(cmd_selection_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%selection_lexpr => cmd%pn_expr
	end subroutine cmd_selection_execute

	@ %def cmd_selection_execute
	@
	\subsubsection{Reweight}
	Define a reweight expression. This is to be applied upon simulation or
	event-file rescanning, event by event. We store the parse tree for the
	right-hand side instead of compiling it. Compilation is deferred to the
	environment where the expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_reweight_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd reweight: TBP>>
	end type cmd_reweight_t

	@ %def cmd_reweight_t
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that scale, renormalization and factorization have been
	defined, respectively.
	<<Commands: cmd reweight: TBP>>=
	procedure :: write => cmd_reweight_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_reweight_write (cmd, unit, indent)
	class(cmd_reweight_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_reweight_write
	<<Commands: procedures>>=
	module subroutine cmd_reweight_write (cmd, unit, indent)
	class(cmd_reweight_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "reweight expression: [defined]"
	end subroutine cmd_reweight_write

	@ %def cmd_reweight_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd reweight: TBP>>=
	procedure :: compile => cmd_reweight_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_reweight_compile (cmd, global)
	class(cmd_reweight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_reweight_compile
	<<Commands: procedures>>=
	module subroutine cmd_reweight_compile (cmd, global)
	class(cmd_reweight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_reweight_compile

	@ %def cmd_reweight_compile
	@ Instead of evaluating the expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd reweight: TBP>>=
	procedure :: execute => cmd_reweight_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_reweight_execute (cmd, global)
	class(cmd_reweight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_reweight_execute
	<<Commands: procedures>>=
	module subroutine cmd_reweight_execute (cmd, global)
	class(cmd_reweight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%reweight_expr => cmd%pn_expr
	end subroutine cmd_reweight_execute

	@ %def cmd_reweight_execute
	@
	\subsubsection{Alternative Simulation Setups}
	Together with simulation, we can re-evaluate event weights in the context of
	alternative setups. The [[cmd_alt_setup_t]] object is designed to hold these
	setups, which are brace-enclosed command lists. Compilation is deferred to
	the simulation environment where the setup expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_alt_setup_t
	private
	type(parse_node_p), dimension(:), allocatable :: setup
	contains
	<<Commands: cmd alt setup: TBP>>
	end type cmd_alt_setup_t

	@ %def cmd_alt_setup_t
	@ Output. Print just a message that the alternative setup list has been
	defined.
	<<Commands: cmd alt setup: TBP>>=
	procedure :: write => cmd_alt_setup_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_alt_setup_write (cmd, unit, indent)
	class(cmd_alt_setup_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_alt_setup_write
	<<Commands: procedures>>=
	module subroutine cmd_alt_setup_write (cmd, unit, indent)
	class(cmd_alt_setup_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,I0,A)") "alt_setup: ", size (cmd%setup), " entries"
	end subroutine cmd_alt_setup_write

	@ %def cmd_alt_setup_write
	@ Compile. Store the parse sub-trees in an array.
	<<Commands: cmd alt setup: TBP>>=
	procedure :: compile => cmd_alt_setup_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_alt_setup_compile (cmd, global)
	class(cmd_alt_setup_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_alt_setup_compile
	<<Commands: procedures>>=
	module subroutine cmd_alt_setup_compile (cmd, global)
	class(cmd_alt_setup_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_list, pn_setup
	integer :: i
	pn_list => parse_node_get_sub_ptr (cmd%pn, 3)
	if (associated (pn_list)) then
	allocate (cmd%setup (parse_node_get_n_sub (pn_list)))
	i = 1
	pn_setup => parse_node_get_sub_ptr (pn_list)
	do while (associated (pn_setup))
	cmd%setup(i)%ptr => pn_setup
	i = i + 1
	pn_setup => parse_node_get_next_ptr (pn_setup)
	end do
	else
	allocate (cmd%setup (0))
	end if
	end subroutine cmd_alt_setup_compile

	@ %def cmd_alt_setup_compile
	@ Execute. Transfer the array of command lists to the global environment.
	<<Commands: cmd alt setup: TBP>>=
	procedure :: execute => cmd_alt_setup_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_alt_setup_execute (cmd, global)
	class(cmd_alt_setup_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_alt_setup_execute
	<<Commands: procedures>>=
	module subroutine cmd_alt_setup_execute (cmd, global)
	class(cmd_alt_setup_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (allocated (global%pn%alt_setup)) deallocate (global%pn%alt_setup)
	allocate (global%pn%alt_setup (size (cmd%setup)))
	global%pn%alt_setup = cmd%setup
	end subroutine cmd_alt_setup_execute

	@ %def cmd_alt_setup_execute
	@
	\subsubsection{Integration}
	Integrate several processes, consecutively with identical parameters.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_integrate_t
	private
	integer :: n_proc = 0
	type(string_t), dimension(:), allocatable :: process_id
	contains
	<<Commands: cmd integrate: TBP>>
	end type cmd_integrate_t

	@ %def cmd_integrate_t
	@ Output: we know the process IDs.
	<<Commands: cmd integrate: TBP>>=
	procedure :: write => cmd_integrate_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_integrate_write (cmd, unit, indent)
	class(cmd_integrate_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_integrate_write
	<<Commands: procedures>>=
	module subroutine cmd_integrate_write (cmd, unit, indent)
	class(cmd_integrate_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "integrate ("
	do i = 1, cmd%n_proc
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (cmd%process_id(i))
	end do
	write (u, "(A)") ")"
	end subroutine cmd_integrate_write

	@ %def cmd_integrate_write
	@ Compile.
	<<Commands: cmd integrate: TBP>>=
	procedure :: compile => cmd_integrate_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_integrate_compile (cmd, global)
	class(cmd_integrate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_integrate_compile
	<<Commands: procedures>>=
	module subroutine cmd_integrate_compile (cmd, global)
	class(cmd_integrate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_proclist, pn_proc
	integer :: i
	pn_proclist => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
	call cmd%compile_options (global)
	cmd%n_proc = parse_node_get_n_sub (pn_proclist)
	allocate (cmd%process_id (cmd%n_proc))
	pn_proc => parse_node_get_sub_ptr (pn_proclist)
	do i = 1, cmd%n_proc
	cmd%process_id(i) = parse_node_get_string (pn_proc)
	call global%process_stack%init_result_vars (cmd%process_id(i))
	pn_proc => parse_node_get_next_ptr (pn_proc)
	end do
	end subroutine cmd_integrate_compile

	@ %def cmd_integrate_compile
	@ Command execution. Integrate the process(es) with the predefined number
	of passes, iterations and calls. For structure functions, cuts,
	weight and scale, use local definitions if present; by default, the local
	definitions are initialized with the global ones.

	The [[integrate]] procedure should take its input from the currently
	active local environment, but produce a process record in the stack of
	the global environment.

	Since the process acquires a snapshot of the variable list, so if the global
	list (or the local one) is deleted, this does no harm. This implies that
	later changes of the variable list do not affect the stored process.
	<<Commands: cmd integrate: TBP>>=
	procedure :: execute => cmd_integrate_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_integrate_execute (cmd, global)
	class(cmd_integrate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_integrate_execute
	<<Commands: procedures>>=
	module subroutine cmd_integrate_execute (cmd, global)
	class(cmd_integrate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	integer :: i
	if (debug_on) call msg_debug (D_CORE, "cmd_integrate_execute")
	do i = 1, cmd%n_proc
	if (debug_on) call msg_debug &
	(D_CORE, "cmd%process_id(i) ", cmd%process_id(i))
	call integrate_process (cmd%process_id(i), cmd%local, global)
	call global%process_stack%fill_result_vars (cmd%process_id(i))
	call global%process_stack%update_result_vars &
	(cmd%process_id(i), global%var_list)
	if (signal_is_pending ()) return
	end do
	end subroutine cmd_integrate_execute

	@ %def cmd_integrate_execute
	@
	\subsubsection{Observables}
	Declare an observable. After the declaration, it can be used to
	record data, and at the end one can retrieve average and error.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_observable_t
	private
	type(string_t) :: id
	contains
	<<Commands: cmd observable: TBP>>
	end type cmd_observable_t

	@ %def cmd_observable_t
	@ Output. We know the ID.
	<<Commands: cmd observable: TBP>>=
	procedure :: write => cmd_observable_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_observable_write (cmd, unit, indent)
	class(cmd_observable_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_observable_write
	<<Commands: procedures>>=
	module subroutine cmd_observable_write (cmd, unit, indent)
	class(cmd_observable_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A)") "observable: ", char (cmd%id)
	end subroutine cmd_observable_write

	@ %def cmd_observable_write
	@ Compile. Just record the observable ID.
	<<Commands: cmd observable: TBP>>=
	procedure :: compile => cmd_observable_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_observable_compile (cmd, global)
	class(cmd_observable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_observable_compile
	<<Commands: procedures>>=
	module subroutine cmd_observable_compile (cmd, global)
	class(cmd_observable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_tag
	pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (pn_tag)) then
	cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
	end if
	call cmd%compile_options (global)
	select case (char (parse_node_get_rule_key (pn_tag)))
	case ("analysis_id")
	cmd%id = parse_node_get_string (pn_tag)
	case default
	call msg_bug ("observable: name expression not implemented (yet)")
	end select
	end subroutine cmd_observable_compile

	@ %def cmd_observable_compile
	@ Command execution. This declares the observable and allocates it in
	the analysis store.
	<<Commands: cmd observable: TBP>>=
	procedure :: execute => cmd_observable_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_observable_execute (cmd, global)
	class(cmd_observable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_observable_execute
	<<Commands: procedures>>=
	module subroutine cmd_observable_execute (cmd, global)
	class(cmd_observable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(graph_options_t) :: graph_options
	type(string_t) :: label, unit
	var_list => cmd%local%get_var_list_ptr ()
	label = var_list%get_sval (var_str ("$obs_label"))
	unit = var_list%get_sval (var_str ("$obs_unit"))
	call graph_options%init ()
	call set_graph_options (graph_options, var_list)
	call analysis_init_observable (cmd%id, label, unit, graph_options)
	end subroutine cmd_observable_execute

	@ %def cmd_observable_execute
	@
	\subsubsection{Histograms}
	Declare a histogram. At minimum, we have to set lower and upper bound
	and bin width.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_histogram_t
	private
	type(string_t) :: id
	type(parse_node_t), pointer :: pn_lower_bound => null ()
	type(parse_node_t), pointer :: pn_upper_bound => null ()
	type(parse_node_t), pointer :: pn_bin_width => null ()
	contains
	<<Commands: cmd histogram: TBP>>
	end type cmd_histogram_t

	@ %def cmd_histogram_t
	@ Output. Just print the ID.
	<<Commands: cmd histogram: TBP>>=
	procedure :: write => cmd_histogram_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_histogram_write (cmd, unit, indent)
	class(cmd_histogram_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_histogram_write
	<<Commands: procedures>>=
	module subroutine cmd_histogram_write (cmd, unit, indent)
	class(cmd_histogram_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A)") "histogram: ", char (cmd%id)
	end subroutine cmd_histogram_write

	@ %def cmd_histogram_write
	@ Compile. Record the histogram ID and initialize lower, upper bound
	and bin width.
	<<Commands: cmd histogram: TBP>>=
	procedure :: compile => cmd_histogram_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_histogram_compile (cmd, global)
	class(cmd_histogram_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_histogram_compile
	<<Commands: procedures>>=
	module subroutine cmd_histogram_compile (cmd, global)
	class(cmd_histogram_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_tag, pn_args, pn_arg1, pn_arg2, pn_arg3
	character(*), parameter :: e_illegal_use = &
	"illegal usage of 'histogram': insufficient number of arguments"
	pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_args => parse_node_get_next_ptr (pn_tag)
	if (associated (pn_args)) then
	pn_arg1 => parse_node_get_sub_ptr (pn_args)
	if (.not. associated (pn_arg1)) call msg_fatal (e_illegal_use)
	pn_arg2 => parse_node_get_next_ptr (pn_arg1)
	if (.not. associated (pn_arg2)) call msg_fatal (e_illegal_use)
	pn_arg3 => parse_node_get_next_ptr (pn_arg2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_args)
	end if
	call cmd%compile_options (global)
	select case (char (parse_node_get_rule_key (pn_tag)))
	case ("analysis_id")
	cmd%id = parse_node_get_string (pn_tag)
	case default
	call msg_bug ("histogram: name expression not implemented (yet)")
	end select
	cmd%pn_lower_bound => pn_arg1
	cmd%pn_upper_bound => pn_arg2
	cmd%pn_bin_width => pn_arg3
	end subroutine cmd_histogram_compile

	@ %def cmd_histogram_compile
	@ Command execution. This declares the histogram and allocates it in
	the analysis store.
	<<Commands: cmd histogram: TBP>>=
	procedure :: execute => cmd_histogram_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_histogram_execute (cmd, global)
	class(cmd_histogram_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_histogram_execute
	<<Commands: procedures>>=
	module subroutine cmd_histogram_execute (cmd, global)
	class(cmd_histogram_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default) :: lower_bound, upper_bound, bin_width
	integer :: bin_number
	logical :: bin_width_is_used, normalize_bins
	type(string_t) :: obs_label, obs_unit
	type(graph_options_t) :: graph_options
	type(drawing_options_t) :: drawing_options

	var_list => cmd%local%get_var_list_ptr ()
	lower_bound = eval_real (cmd%pn_lower_bound, var_list)
	upper_bound = eval_real (cmd%pn_upper_bound, var_list)
	if (associated (cmd%pn_bin_width)) then
	bin_width = eval_real (cmd%pn_bin_width, var_list)
	bin_width_is_used = .true.
	else if (var_list%is_known (var_str ("n_bins"))) then
	bin_number = &
	var_list%get_ival (var_str ("n_bins"))
	bin_width_is_used = .false.
	else
	call msg_error ("Cmd '" // char (cmd%id) // &
	"': neither bin width nor number is defined")
	end if
	normalize_bins = &
	var_list%get_lval (var_str ("?normalize_bins"))
	obs_label = &
	var_list%get_sval (var_str ("$obs_label"))
	obs_unit = &
	var_list%get_sval (var_str ("$obs_unit"))

	call graph_options%init ()
	call set_graph_options (graph_options, var_list)
	call drawing_options%init_histogram ()
	call set_drawing_options (drawing_options, var_list)

	if (bin_width_is_used) then
	call analysis_init_histogram &
	(cmd%id, lower_bound, upper_bound, bin_width, &
	normalize_bins, &
	obs_label, obs_unit, &
	graph_options, drawing_options)
	else
	call analysis_init_histogram &
	(cmd%id, lower_bound, upper_bound, bin_number, &
	normalize_bins, &
	obs_label, obs_unit, &
	graph_options, drawing_options)
	end if
	end subroutine cmd_histogram_execute

	@ %def cmd_histogram_execute
	@ Set the graph options from a variable list.
	<<Commands: procedures>>=
	subroutine set_graph_options (gro, var_list)
	type(graph_options_t), intent(inout) :: gro
	type(var_list_t), intent(in) :: var_list
	call gro%set (title = var_list%get_sval (var_str ("$title")))
	call gro%set (description = var_list%get_sval (var_str ("$description")))
	call gro%set (x_label = var_list%get_sval (var_str ("$x_label")))
	call gro%set (y_label = var_list%get_sval (var_str ("$y_label")))
	call gro%set (width_mm = var_list%get_ival (var_str ("graph_width_mm")))
	call gro%set (height_mm = var_list%get_ival (var_str ("graph_height_mm")))
	call gro%set (x_log = var_list%get_lval (var_str ("?x_log")))
	call gro%set (y_log = var_list%get_lval (var_str ("?y_log")))
	if (var_list%is_known (var_str ("x_min"))) &
	call gro%set (x_min = var_list%get_rval (var_str ("x_min")))
	if (var_list%is_known (var_str ("x_max"))) &
	call gro%set (x_max = var_list%get_rval (var_str ("x_max")))
	if (var_list%is_known (var_str ("y_min"))) &
	call gro%set (y_min = var_list%get_rval (var_str ("y_min")))
	if (var_list%is_known (var_str ("y_max"))) &
	call gro%set (y_max = var_list%get_rval (var_str ("y_max")))
	call gro%set (gmlcode_bg = var_list%get_sval (var_str ("$gmlcode_bg")))
	call gro%set (gmlcode_fg = var_list%get_sval (var_str ("$gmlcode_fg")))
	end subroutine set_graph_options

	@ %def set_graph_options
	@ Set the drawing options from a variable list.
	<<Commands: procedures>>=
	subroutine set_drawing_options (dro, var_list)
	type(drawing_options_t), intent(inout) :: dro
	type(var_list_t), intent(in) :: var_list
	if (var_list%is_known (var_str ("?draw_histogram"))) then
	if (var_list%get_lval (var_str ("?draw_histogram"))) then
	call dro%set (with_hbars = .true.)
	else
	call dro%set (with_hbars = .false., &
	with_base = .false., fill = .false., piecewise = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?draw_base"))) then
	if (var_list%get_lval (var_str ("?draw_base"))) then
	call dro%set (with_base = .true.)
	else
	call dro%set (with_base = .false., fill = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?draw_piecewise"))) then
	if (var_list%get_lval (var_str ("?draw_piecewise"))) then
	call dro%set (piecewise = .true.)
	else
	call dro%set (piecewise = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?fill_curve"))) then
	if (var_list%get_lval (var_str ("?fill_curve"))) then
	call dro%set (fill = .true., with_base = .true.)
	else
	call dro%set (fill = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?draw_curve"))) then
	if (var_list%get_lval (var_str ("?draw_curve"))) then
	call dro%set (draw = .true.)
	else
	call dro%set (draw = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?draw_errors"))) then
	if (var_list%get_lval (var_str ("?draw_errors"))) then
	call dro%set (err = .true.)
	else
	call dro%set (err = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?draw_symbols"))) then
	if (var_list%get_lval (var_str ("?draw_symbols"))) then
	call dro%set (symbols = .true.)
	else
	call dro%set (symbols = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("$fill_options"))) then
	call dro%set (fill_options = &
	var_list%get_sval (var_str ("$fill_options")))
	end if
	if (var_list%is_known (var_str ("$draw_options"))) then
	call dro%set (draw_options = &
	var_list%get_sval (var_str ("$draw_options")))
	end if
	if (var_list%is_known (var_str ("$err_options"))) then
	call dro%set (err_options = &
	var_list%get_sval (var_str ("$err_options")))
	end if
	if (var_list%is_known (var_str ("$symbol"))) then
	call dro%set (symbol = &
	var_list%get_sval (var_str ("$symbol")))
	end if
	if (var_list%is_known (var_str ("$gmlcode_bg"))) then
	call dro%set (gmlcode_bg = &
	var_list%get_sval (var_str ("$gmlcode_bg")))
	end if
	if (var_list%is_known (var_str ("$gmlcode_fg"))) then
	call dro%set (gmlcode_fg = &
	var_list%get_sval (var_str ("$gmlcode_fg")))
	end if
	end subroutine set_drawing_options

	@ %def set_drawing_options
	@
	\subsubsection{Plots}
	Declare a plot. No mandatory arguments, just options.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_plot_t
	private
	type(string_t) :: id
	contains
	<<Commands: cmd plot: TBP>>
	end type cmd_plot_t

	@ %def cmd_plot_t
	@ Output. Just print the ID.
	<<Commands: cmd plot: TBP>>=
	procedure :: write => cmd_plot_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_plot_write (cmd, unit, indent)
	class(cmd_plot_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_plot_write
	<<Commands: procedures>>=
	module subroutine cmd_plot_write (cmd, unit, indent)
	class(cmd_plot_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A)") "plot: ", char (cmd%id)
	end subroutine cmd_plot_write

	@ %def cmd_plot_write
	@ Compile. Record the plot ID and initialize lower, upper bound
	and bin width.
	<<Commands: cmd plot: TBP>>=
	procedure :: compile => cmd_plot_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_plot_compile (cmd, global)
	class(cmd_plot_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_plot_compile
	<<Commands: procedures>>=
	module subroutine cmd_plot_compile (cmd, global)
	class(cmd_plot_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_tag
	pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
	call cmd%init (pn_tag, global)
	end subroutine cmd_plot_compile

	@ %def cmd_plot_compile
	@ This init routine is separated because it is reused below for graph
	initialization.
	<<Commands: cmd plot: TBP>>=
	procedure :: init => cmd_plot_init
	<<Commands: sub interfaces>>=
	module subroutine cmd_plot_init (plot, pn_tag, global)
	class(cmd_plot_t), intent(inout) :: plot
	type(parse_node_t), intent(in), pointer :: pn_tag
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_plot_init
	<<Commands: procedures>>=
	module subroutine cmd_plot_init (plot, pn_tag, global)
	class(cmd_plot_t), intent(inout) :: plot
	type(parse_node_t), intent(in), pointer :: pn_tag
	type(rt_data_t), intent(inout), target :: global
	call plot%compile_options (global)
	select case (char (parse_node_get_rule_key (pn_tag)))
	case ("analysis_id")
	plot%id = parse_node_get_string (pn_tag)
	case default
	call msg_bug ("plot: name expression not implemented (yet)")
	end select
	end subroutine cmd_plot_init

	@ %def cmd_plot_init
	@ Command execution. This declares the plot and allocates it in
	the analysis store.
	<<Commands: cmd plot: TBP>>=
	procedure :: execute => cmd_plot_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_plot_execute (cmd, global)
	class(cmd_plot_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_plot_execute
	<<Commands: procedures>>=
	module subroutine cmd_plot_execute (cmd, global)
	class(cmd_plot_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(graph_options_t) :: graph_options
	type(drawing_options_t) :: drawing_options

	var_list => cmd%local%get_var_list_ptr ()
	call graph_options%init ()
	call set_graph_options (graph_options, var_list)
	call drawing_options%init_plot ()
	call set_drawing_options (drawing_options, var_list)

	call analysis_init_plot (cmd%id, graph_options, drawing_options)
	end subroutine cmd_plot_execute

	@ %def cmd_plot_execute
	@
	\subsubsection{Graphs}
	Declare a graph. The graph is defined in terms of its contents. Both the
	graph and its contents may carry options.

	The graph object contains its own ID as well as the IDs of its elements. For
	the elements, we reuse the [[cmd_plot_t]] defined above.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_graph_t
	private
	type(string_t) :: id
	integer :: n_elements = 0
	type(cmd_plot_t), dimension(:), allocatable :: el
	type(string_t), dimension(:), allocatable :: element_id
	contains
	<<Commands: cmd graph: TBP>>
	end type cmd_graph_t

	@ %def cmd_graph_t
	@ Output. Just print the ID.
	<<Commands: cmd graph: TBP>>=
	procedure :: write => cmd_graph_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_graph_write (cmd, unit, indent)
	class(cmd_graph_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_graph_write
	<<Commands: procedures>>=
	module subroutine cmd_graph_write (cmd, unit, indent)
	class(cmd_graph_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A,A,I0,A)") "graph: ", char (cmd%id), &
	" (", cmd%n_elements, " entries)"
	end subroutine cmd_graph_write

	@ %def cmd_graph_write
	@ Compile. Record the graph ID and initialize lower, upper bound
	and bin width. For compiling the graph element syntax, we use part of the
	[[cmd_plot_t]] compiler.

	Note: currently, we do not respect options, therefore just IDs on the RHS.
	<<Commands: cmd graph: TBP>>=
	procedure :: compile => cmd_graph_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_graph_compile (cmd, global)
	class(cmd_graph_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_graph_compile
	<<Commands: procedures>>=
	module subroutine cmd_graph_compile (cmd, global)
	class(cmd_graph_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_term, pn_tag, pn_def, pn_app
	integer :: i

	pn_term => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_tag => parse_node_get_sub_ptr (pn_term)
	cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
	call cmd%compile_options (global)
	select case (char (parse_node_get_rule_key (pn_tag)))
	case ("analysis_id")
	cmd%id = parse_node_get_string (pn_tag)
	case default
	call msg_bug ("graph: name expression not implemented (yet)")
	end select
	pn_def => parse_node_get_next_ptr (pn_term, 2)
	cmd%n_elements = parse_node_get_n_sub (pn_def)
	allocate (cmd%element_id (cmd%n_elements))
	allocate (cmd%el (cmd%n_elements))
	pn_term => parse_node_get_sub_ptr (pn_def)
	pn_tag => parse_node_get_sub_ptr (pn_term)
	cmd%el(1)%pn_opt => parse_node_get_next_ptr (pn_tag)
	call cmd%el(1)%init (pn_tag, global)
	cmd%element_id(1) = parse_node_get_string (pn_tag)
	pn_app => parse_node_get_next_ptr (pn_term)
	do i = 2, cmd%n_elements
	pn_term => parse_node_get_sub_ptr (pn_app, 2)
	pn_tag => parse_node_get_sub_ptr (pn_term)
	cmd%el(i)%pn_opt => parse_node_get_next_ptr (pn_tag)
	call cmd%el(i)%init (pn_tag, global)
	cmd%element_id(i) = parse_node_get_string (pn_tag)
	pn_app => parse_node_get_next_ptr (pn_app)
	end do

	end subroutine cmd_graph_compile

	@ %def cmd_graph_compile
	@ Command execution. This declares the graph, allocates it in
	the analysis store, and copies the graph elements.

	For the graph, we set graph and default drawing options. For the elements, we
	reset individual drawing options.

	This accesses internals of the contained elements of type [[cmd_plot_t]], see
	above. We might disentangle such an interdependency when this code is
	rewritten using proper type extension.
	<<Commands: cmd graph: TBP>>=
	procedure :: execute => cmd_graph_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_graph_execute (cmd, global)
	class(cmd_graph_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_graph_execute
	<<Commands: procedures>>=
	module subroutine cmd_graph_execute (cmd, global)
	class(cmd_graph_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(graph_options_t) :: graph_options
	type(drawing_options_t) :: drawing_options
	integer :: i, type

	var_list => cmd%local%get_var_list_ptr ()
	call graph_options%init ()
	call set_graph_options (graph_options, var_list)
	call analysis_init_graph (cmd%id, cmd%n_elements, graph_options)

	do i = 1, cmd%n_elements
	if (associated (cmd%el(i)%options)) then
	call cmd%el(i)%options%execute (cmd%el(i)%local)
	end if
	type = analysis_store_get_object_type (cmd%element_id(i))
	select case (type)
	case (AN_HISTOGRAM)
	call drawing_options%init_histogram ()
	case (AN_PLOT)
	call drawing_options%init_plot ()
	end select
	call set_drawing_options (drawing_options, var_list)
	if (associated (cmd%el(i)%options)) then
	call set_drawing_options (drawing_options, cmd%el(i)%local%var_list)
	end if
	call analysis_fill_graph (cmd%id, i, cmd%element_id(i), drawing_options)
	end do
	end subroutine cmd_graph_execute

	@ %def cmd_graph_execute
	@
	\subsubsection{Analysis}
	Hold the analysis ID either as a string or as an expression:
	<<Commands: types>>=
	type :: analysis_id_t
	type(string_t) :: tag
	type(parse_node_t), pointer :: pn_sexpr => null ()
	end type analysis_id_t

	@ %def analysis_id_t
	@ Define the analysis expression. We store the parse tree for the
	right-hand side instead of compiling it. Compilation is deferred to
	the process environment where the analysis expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_analysis_t
	private
	type(parse_node_t), pointer :: pn_lexpr => null ()
	contains
	<<Commands: cmd analysis: TBP>>
	end type cmd_analysis_t

	@ %def cmd_analysis_t
	@ Output. Print just a message that analysis has been defined.
	<<Commands: cmd analysis: TBP>>=
	procedure :: write => cmd_analysis_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_analysis_write (cmd, unit, indent)
	class(cmd_analysis_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_analysis_write
	<<Commands: procedures>>=
	module subroutine cmd_analysis_write (cmd, unit, indent)
	class(cmd_analysis_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "analysis: [defined]"
	end subroutine cmd_analysis_write

	@ %def cmd_analysis_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd analysis: TBP>>=
	procedure :: compile => cmd_analysis_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_analysis_compile (cmd, global)
	class(cmd_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_analysis_compile
	<<Commands: procedures>>=
	module subroutine cmd_analysis_compile (cmd, global)
	class(cmd_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_analysis_compile

	@ %def cmd_analysis_compile
	@ Instead of evaluating the cut expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd analysis: TBP>>=
	procedure :: execute => cmd_analysis_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_analysis_execute (cmd, global)
	class(cmd_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_analysis_execute
	<<Commands: procedures>>=
	module subroutine cmd_analysis_execute (cmd, global)
	class(cmd_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%analysis_lexpr => cmd%pn_lexpr
	end subroutine cmd_analysis_execute

	@ %def cmd_analysis_execute
	@
	\subsubsection{Write histograms and plots}
	The data type encapsulating the command:
	<<Commands: types>>=
	type, extends (command_t) :: cmd_write_analysis_t
	private
	type(analysis_id_t), dimension(:), allocatable :: id
	type(string_t), dimension(:), allocatable :: tag
	contains
	<<Commands: cmd write analysis: TBP>>
	end type cmd_write_analysis_t

	@ %def analysis_id_t
	@ %def cmd_write_analysis_t
	@ Output. Just the keyword.
	<<Commands: cmd write analysis: TBP>>=
	procedure :: write => cmd_write_analysis_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_write_analysis_write (cmd, unit, indent)
	class(cmd_write_analysis_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_write_analysis_write
	<<Commands: procedures>>=
	module subroutine cmd_write_analysis_write (cmd, unit, indent)
	class(cmd_write_analysis_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "write_analysis"
	end subroutine cmd_write_analysis_write

	@ %def cmd_write_analysis_write
	@ Compile.
	<<Commands: cmd write analysis: TBP>>=
	procedure :: compile => cmd_write_analysis_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_write_analysis_compile (cmd, global)
	class(cmd_write_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_write_analysis_compile
	<<Commands: procedures>>=
	module subroutine cmd_write_analysis_compile (cmd, global)
	class(cmd_write_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_clause, pn_args, pn_id
	integer :: n, i
	pn_clause => parse_node_get_sub_ptr (cmd%pn)
	pn_args => parse_node_get_sub_ptr (pn_clause, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_clause)
	call cmd%compile_options (global)
	if (associated (pn_args)) then
	n = parse_node_get_n_sub (pn_args)
	allocate (cmd%id (n))
	do i = 1, n
	pn_id => parse_node_get_sub_ptr (pn_args, i)
	if (char (parse_node_get_rule_key (pn_id)) == "analysis_id") then
	cmd%id(i)%tag = parse_node_get_string (pn_id)
	else
	cmd%id(i)%pn_sexpr => pn_id
	end if
	end do
	else
	allocate (cmd%id (0))
	end if
	end subroutine cmd_write_analysis_compile

	@ %def cmd_write_analysis_compile
	@ The output format for real data values:
	<<Commands: parameters>>=
	character(*), parameter, public :: &
	DEFAULT_ANALYSIS_FILENAME = "whizard_analysis.dat"
	character(len=1), dimension(2), parameter, public :: &
	FORBIDDEN_ENDINGS1 = [ "o", "a" ]
	character(len=2), dimension(6), parameter, public :: &
	FORBIDDEN_ENDINGS2 = [ "mp", "ps", "vg", "pg", "lo", "la" ]
	character(len=3), dimension(20), parameter, public :: &
	FORBIDDEN_ENDINGS3 = [ "aux", "dvi", "evt", "evx", "f03", "f90", &
	"f95", "log", "ltp", "mod", "mpx", "olc", "olp", "pdf", "phs", &
	"sin", "sub", "tex", "vg2", "vgx" ]

	@ %def DEFAULT_ANALYSIS_FILENAME
	@ %def FORBIDDEN_ENDINGS1
	@ %def FORBIDDEN_ENDINGS2
	@ %def FORBIDDEN_ENDINGS3
	@ As this contains a lot of similar code to [[cmd_compile_analysis_execute]]
	we outsource the main code to a subroutine.
	<<Commands: cmd write analysis: TBP>>=
	procedure :: execute => cmd_write_analysis_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_write_analysis_execute (cmd, global)
	class(cmd_write_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_write_analysis_execute
	<<Commands: procedures>>=
	module subroutine cmd_write_analysis_execute (cmd, global)
	class(cmd_write_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	var_list => cmd%local%get_var_list_ptr ()
	call write_analysis_wrap (var_list, global%out_files, &
	cmd%id, tag = cmd%tag)
	end subroutine cmd_write_analysis_execute

	@ %def cmd_write_analysis_execute
	@ If the [[data_file]] optional argument is present, this is
	called from [[cmd_compile_analysis_execute]], which needs the file name for
	further processing, and requires the default format. For the moment,
	parameters and macros for custom data processing are disabled.
	<<Commands: procedures>>=
	subroutine write_analysis_wrap (var_list, out_files, id, tag, data_file)
	type(var_list_t), intent(inout), target :: var_list
	type(file_list_t), intent(inout), target :: out_files
	type(analysis_id_t), dimension(:), intent(in), target :: id
	type(string_t), dimension(:), allocatable, intent(out) :: tag
	type(string_t), intent(out), optional :: data_file
	type(string_t) :: defaultfile, file
	integer :: i
	logical :: keep_open
	type(string_t) :: extension
	logical :: one_file
	defaultfile = var_list%get_sval (var_str ("$out_file"))
	if (present (data_file)) then
	if (defaultfile == "" .or. defaultfile == ".") then
	defaultfile = DEFAULT_ANALYSIS_FILENAME
	else
	if (scan (".", defaultfile) > 0) then
	call split (defaultfile, extension, ".", back=.true.)
	if (any (lower_case (char(extension)) == FORBIDDEN_ENDINGS1) .or. &
	any (lower_case (char(extension)) == FORBIDDEN_ENDINGS2) .or. &
	any (lower_case (char(extension)) == FORBIDDEN_ENDINGS3)) &
	call msg_fatal ("The ending " // char(extension) // &
	" is internal and not allowed as data file.")
	if (extension /= "") then
	if (defaultfile /= "") then
	defaultfile = defaultfile // "." // extension
	else
	defaultfile = "whizard_analysis." // extension
	end if
	else
	defaultfile = defaultfile // ".dat"
	endif
	else
	defaultfile = defaultfile // ".dat"
	end if
	end if
	data_file = defaultfile
	end if
	one_file = defaultfile /= ""
	if (one_file) then
	file = defaultfile
	keep_open = file_list_is_open (out_files, file, &
	action = "write")
	if (keep_open) then
	if (present (data_file)) then
	call msg_fatal ("Compiling analysis: File '" &
	// char (data_file) &
	// "' can't be used, it is already open.")
	else
	call msg_message ("Appending analysis data to file '" &
	// char (file) // "'")
	end if
	else
	call file_list_open (out_files, file, &
	action = "write", status = "replace", position = "asis")
	call msg_message ("Writing analysis data to file '" &
	// char (file) // "'")
	end if
	end if

	call get_analysis_tags (tag, id, var_list)
	do i = 1, size (tag)
	call file_list_write_analysis &
	(out_files, file, tag(i))
	end do
	if (one_file .and. .not. keep_open) then
	call file_list_close (out_files, file)
	end if

	contains

	subroutine get_analysis_tags (analysis_tag, id, var_list)
	type(string_t), dimension(:), intent(out), allocatable :: analysis_tag
	type(analysis_id_t), dimension(:), intent(in) :: id
	type(var_list_t), intent(in), target :: var_list
	if (size (id) /= 0) then
	allocate (analysis_tag (size (id)))
	do i = 1, size (id)
	if (associated (id(i)%pn_sexpr)) then
	analysis_tag(i) = eval_string (id(i)%pn_sexpr, var_list)
	else
	analysis_tag(i) = id(i)%tag
	end if
	end do
	else
	call analysis_store_get_ids (tag)
	end if
	end subroutine get_analysis_tags

	end subroutine write_analysis_wrap

	@ %def write_analysis_wrap
	\subsubsection{Compile analysis results}
	This command writes files in a form suitable for GAMELAN and executes the
	appropriate commands to compile them. The first part is identical to
	[[cmd_write_analysis]].
	<<Commands: types>>=
	type, extends (command_t) :: cmd_compile_analysis_t
	private
	type(analysis_id_t), dimension(:), allocatable :: id
	type(string_t), dimension(:), allocatable :: tag
	contains
	<<Commands: cmd compile analysis: TBP>>
	end type cmd_compile_analysis_t

	@ %def cmd_compile_analysis_t
	@ Output. Just the keyword.
	<<Commands: cmd compile analysis: TBP>>=
	procedure :: write => cmd_compile_analysis_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_compile_analysis_write (cmd, unit, indent)
	class(cmd_compile_analysis_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_compile_analysis_write
	<<Commands: procedures>>=
	module subroutine cmd_compile_analysis_write (cmd, unit, indent)
	class(cmd_compile_analysis_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "compile_analysis"
	end subroutine cmd_compile_analysis_write

	@ %def cmd_compile_analysis_write
	@ Compile.
	<<Commands: cmd compile analysis: TBP>>=
	procedure :: compile => cmd_compile_analysis_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_compile_analysis_compile (cmd, global)
	class(cmd_compile_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_compile_analysis_compile
	<<Commands: procedures>>=
	module subroutine cmd_compile_analysis_compile (cmd, global)
	class(cmd_compile_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_clause, pn_args, pn_id
	integer :: n, i
	pn_clause => parse_node_get_sub_ptr (cmd%pn)
	pn_args => parse_node_get_sub_ptr (pn_clause, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_clause)
	call cmd%compile_options (global)
	if (associated (pn_args)) then
	n = parse_node_get_n_sub (pn_args)
	allocate (cmd%id (n))
	do i = 1, n
	pn_id => parse_node_get_sub_ptr (pn_args, i)
	if (char (parse_node_get_rule_key (pn_id)) == "analysis_id") then
	cmd%id(i)%tag = parse_node_get_string (pn_id)
	else
	cmd%id(i)%pn_sexpr => pn_id
	end if
	end do
	else
	allocate (cmd%id (0))
	end if
	end subroutine cmd_compile_analysis_compile

	@ %def cmd_compile_analysis_compile
	@ First write the analysis data to file, then write a GAMELAN driver and
	produce MetaPost and \TeX\ output.
	<<Commands: cmd compile analysis: TBP>>=
	procedure :: execute => cmd_compile_analysis_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_compile_analysis_execute (cmd, global)
	class(cmd_compile_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_compile_analysis_execute
	<<Commands: procedures>>=
	module subroutine cmd_compile_analysis_execute (cmd, global)
	class(cmd_compile_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(string_t) :: file, basename, extension, driver_file, &
	makefile
	integer :: u_driver, u_makefile
	logical :: has_gmlcode, only_file
	var_list => cmd%local%get_var_list_ptr ()
	call write_analysis_wrap (var_list, &
	global%out_files, cmd%id, tag = cmd%tag, &
	data_file = file)
	basename = file
	if (scan (".", basename) > 0) then
	call split (basename, extension, ".", back=.true.)
	else
	extension = ""
	end if
	driver_file = basename // ".tex"
	makefile = basename // "_ana.makefile"
	u_driver = free_unit ()
	open (unit=u_driver, file=char(driver_file), &
	action="write", status="replace")
	if (allocated (cmd%tag)) then
	call analysis_write_driver (file, cmd%tag, unit=u_driver)
	has_gmlcode = analysis_has_plots (cmd%tag)
	else
	call analysis_write_driver (file, unit=u_driver)
	has_gmlcode = analysis_has_plots ()
	end if
	close (u_driver)
	u_makefile = free_unit ()
	open (unit=u_makefile, file=char(makefile), &
	action="write", status="replace")
	call analysis_write_makefile (basename, u_makefile, &
	has_gmlcode, global%os_data)
	close (u_makefile)
	call msg_message ("Compiling analysis results display in '" &
	// char (driver_file) // "'")
	call msg_message ("Providing analysis steering makefile '" &
	// char (makefile) // "'")
	only_file = global%var_list%get_lval &
	(var_str ("?analysis_file_only"))
	if (.not. only_file) call analysis_compile_tex &
	(basename, has_gmlcode, global%os_data)
	end subroutine cmd_compile_analysis_execute

	@ %def cmd_compile_analysis_execute
	@
	\subsection{User-controlled output to data files}

	\subsubsection{Open file (output)}
	Open a file for output.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_open_out_t
	private
	type(parse_node_t), pointer :: file_expr => null ()
	contains
	<<Commands: cmd open out: TBP>>
	end type cmd_open_out_t

	@ %def cmd_open_out
	@ Finalizer for the embedded eval tree.
	<<Commands: procedures>>=
	subroutine cmd_open_out_final (object)
	class(cmd_open_out_t), intent(inout) :: object
	end subroutine cmd_open_out_final

	@ %def cmd_open_out_final
	@ Output (trivial here).
	<<Commands: cmd open out: TBP>>=
	procedure :: write => cmd_open_out_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_open_out_write (cmd, unit, indent)
	class(cmd_open_out_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_open_out_write
	<<Commands: procedures>>=
	module subroutine cmd_open_out_write (cmd, unit, indent)
	class(cmd_open_out_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "open_out: <filename>"
	end subroutine cmd_open_out_write

	@ %def cmd_open_out_write
	@ Compile: create an eval tree for the filename expression.
	<<Commands: cmd open out: TBP>>=
	procedure :: compile => cmd_open_out_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_open_out_compile (cmd, global)
	class(cmd_open_out_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_open_out_compile
	<<Commands: procedures>>=
	module subroutine cmd_open_out_compile (cmd, global)
	class(cmd_open_out_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%file_expr => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (cmd%file_expr)) then
	cmd%pn_opt => parse_node_get_next_ptr (cmd%file_expr)
	end if
	call cmd%compile_options (global)
	end subroutine cmd_open_out_compile

	@ %def cmd_open_out_compile
	@ Execute: append the file to the global list of open files.
	<<Commands: cmd open out: TBP>>=
	procedure :: execute => cmd_open_out_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_open_out_execute (cmd, global)
	class(cmd_open_out_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_open_out_execute
	<<Commands: procedures>>=
	module subroutine cmd_open_out_execute (cmd, global)
	class(cmd_open_out_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(eval_tree_t) :: file_expr
	type(string_t) :: file
	var_list => cmd%local%get_var_list_ptr ()
	call file_expr%init_sexpr (cmd%file_expr, var_list)
	call file_expr%evaluate ()
	if (file_expr%is_known ()) then
	file = file_expr%get_string ()
	call file_list_open (global%out_files, file, &
	action = "write", status = "replace", position = "asis")
	else
	call msg_fatal ("open_out: file name argument evaluates to unknown")
	end if
	call file_expr%final ()
	end subroutine cmd_open_out_execute

	@ %def cmd_open_out_execute

	\subsubsection{Open file (output)}
	Close an output file. Except for the [[execute]] method, everything is
	analogous to the open command, so we can just inherit.
	<<Commands: types>>=
	type, extends (cmd_open_out_t) :: cmd_close_out_t
	private
	contains
	<<Commands: cmd close out: TBP>>
	end type cmd_close_out_t

	@ %def cmd_close_out
	@ Execute: remove the file from the global list of output files.
	<<Commands: cmd close out: TBP>>=
	procedure :: execute => cmd_close_out_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_close_out_execute (cmd, global)
	class(cmd_close_out_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_close_out_execute
	<<Commands: procedures>>=
	module subroutine cmd_close_out_execute (cmd, global)
	class(cmd_close_out_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(eval_tree_t) :: file_expr
	type(string_t) :: file
	var_list => cmd%local%var_list
	call file_expr%init_sexpr (cmd%file_expr, var_list)
	call file_expr%evaluate ()
	if (file_expr%is_known ()) then
	file = file_expr%get_string ()
	call file_list_close (global%out_files, file)
	else
	call msg_fatal ("close_out: file name argument evaluates to unknown")
	end if
	call file_expr%final ()
	end subroutine cmd_close_out_execute

	@ %def cmd_close_out_execute
	@
	\subsection{Print custom-formatted values}
	<<Commands: types>>=
	type, extends (command_t) :: cmd_printf_t
	private
	type(parse_node_t), pointer :: sexpr => null ()
	type(parse_node_t), pointer :: sprintf_fun => null ()
	type(parse_node_t), pointer :: sprintf_clause => null ()
	type(parse_node_t), pointer :: sprintf => null ()
	contains
	<<Commands: cmd printf: TBP>>
	end type cmd_printf_t

	@ %def cmd_printf_t
	@ Finalize.
	<<Commands: cmd printf: TBP>>=
	procedure :: final => cmd_printf_final
	<<Commands: sub interfaces>>=
	module subroutine cmd_printf_final (cmd)
	class(cmd_printf_t), intent(inout) :: cmd
	end subroutine cmd_printf_final
	<<Commands: procedures>>=
	module subroutine cmd_printf_final (cmd)
	class(cmd_printf_t), intent(inout) :: cmd
	call parse_node_final (cmd%sexpr, recursive = .false.)
	deallocate (cmd%sexpr)
	call parse_node_final (cmd%sprintf_fun, recursive = .false.)
	deallocate (cmd%sprintf_fun)
	call parse_node_final (cmd%sprintf_clause, recursive = .false.)
	deallocate (cmd%sprintf_clause)
	call parse_node_final (cmd%sprintf, recursive = .false.)
	deallocate (cmd%sprintf)
	end subroutine cmd_printf_final

	@ %def cmd_printf_final
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that cuts have been defined.
	<<Commands: cmd printf: TBP>>=
	procedure :: write => cmd_printf_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_printf_write (cmd, unit, indent)
	class(cmd_printf_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_printf_write
	<<Commands: procedures>>=
	module subroutine cmd_printf_write (cmd, unit, indent)
	class(cmd_printf_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "printf:"
	end subroutine cmd_printf_write

	@ %def cmd_printf_write
	@ Compile. We create a fake parse node (subtree) with a [[sprintf]] command
	with identical arguments which can then be handled by the corresponding
	evaluation procedure.
	<<Commands: cmd printf: TBP>>=
	procedure :: compile => cmd_printf_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_printf_compile (cmd, global)
	class(cmd_printf_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_printf_compile
	<<Commands: procedures>>=
	module subroutine cmd_printf_compile (cmd, global)
	class(cmd_printf_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_cmd, pn_clause, pn_args, pn_format
	pn_cmd => parse_node_get_sub_ptr (cmd%pn)
	pn_clause => parse_node_get_sub_ptr (pn_cmd)
	pn_format => parse_node_get_sub_ptr (pn_clause, 2)
	pn_args => parse_node_get_next_ptr (pn_clause)
	cmd%pn_opt => parse_node_get_next_ptr (pn_cmd)
	call cmd%compile_options (global)
	allocate (cmd%sexpr)
	call parse_node_create_branch (cmd%sexpr, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("sexpr")))
	allocate (cmd%sprintf_fun)
	call parse_node_create_branch (cmd%sprintf_fun, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf_fun")))
	allocate (cmd%sprintf_clause)
	call parse_node_create_branch (cmd%sprintf_clause, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf_clause")))
	allocate (cmd%sprintf)
	call parse_node_create_key (cmd%sprintf, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf")))
	call parse_node_append_sub (cmd%sprintf_clause, cmd%sprintf)
	call parse_node_append_sub (cmd%sprintf_clause, pn_format)
	call parse_node_freeze_branch (cmd%sprintf_clause)
	call parse_node_append_sub (cmd%sprintf_fun, cmd%sprintf_clause)
	if (associated (pn_args)) then
	call parse_node_append_sub (cmd%sprintf_fun, pn_args)
	end if
	call parse_node_freeze_branch (cmd%sprintf_fun)
	call parse_node_append_sub (cmd%sexpr, cmd%sprintf_fun)
	call parse_node_freeze_branch (cmd%sexpr)
	end subroutine cmd_printf_compile

	@ %def cmd_printf_compile
	@ Execute. Evaluate the string (pretending this is a [[sprintf]] expression)
	and print it.
	<<Commands: cmd printf: TBP>>=
	procedure :: execute => cmd_printf_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_printf_execute (cmd, global)
	class(cmd_printf_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_printf_execute
	<<Commands: procedures>>=
	module subroutine cmd_printf_execute (cmd, global)
	class(cmd_printf_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(string_t) :: string, file
	type(eval_tree_t) :: sprintf_expr
	logical :: advance
	var_list => cmd%local%get_var_list_ptr ()
	advance = var_list%get_lval (&
	var_str ("?out_advance"))
	file = var_list%get_sval (&
	var_str ("$out_file"))
	call sprintf_expr%init_sexpr (cmd%sexpr, var_list)
	call sprintf_expr%evaluate ()
	if (sprintf_expr%is_known ()) then
	string = sprintf_expr%get_string ()
	if (len (file) == 0) then
	call msg_result (char (string))
	else
	call file_list_write (global%out_files, file, string, advance)
	end if
	end if
	end subroutine cmd_printf_execute

	@ %def cmd_printf_execute
	@
	\subsubsection{Record data}
	The expression syntax already contains a [[record]] keyword; this evaluates to
	a logical which is always true, but it has the side-effect of recording data
	into analysis objects. Here we define a command as an interface to this
	construct.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_record_t
	private
	type(parse_node_t), pointer :: pn_lexpr => null ()
	contains
	<<Commands: cmd record: TBP>>
	end type cmd_record_t

	@ %def cmd_record_t
	@ Output. With the compile hack below, there is nothing of interest
	to print here.
	<<Commands: cmd record: TBP>>=
	procedure :: write => cmd_record_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_record_write (cmd, unit, indent)
	class(cmd_record_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_record_write
	<<Commands: procedures>>=
	module subroutine cmd_record_write (cmd, unit, indent)
	class(cmd_record_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "record"
	end subroutine cmd_record_write

	@ %def cmd_record_write
	@ Compile. This is a hack which transforms the [[record]] command
	into a [[record]] expression, which we handle in the [[expressions]]
	module.
	<<Commands: cmd record: TBP>>=
	procedure :: compile => cmd_record_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_record_compile (cmd, global)
	class(cmd_record_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_record_compile
	<<Commands: procedures>>=
	module subroutine cmd_record_compile (cmd, global)
	class(cmd_record_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_lexpr, pn_lsinglet, pn_lterm, pn_record
	call parse_node_create_branch (pn_lexpr, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("lexpr")))
	call parse_node_create_branch (pn_lsinglet, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("lsinglet")))
	call parse_node_append_sub (pn_lexpr, pn_lsinglet)
	call parse_node_create_branch (pn_lterm, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("lterm")))
	call parse_node_append_sub (pn_lsinglet, pn_lterm)
	pn_record => parse_node_get_sub_ptr (cmd%pn)
	call parse_node_append_sub (pn_lterm, pn_record)
	cmd%pn_lexpr => pn_lexpr
	end subroutine cmd_record_compile

	@ %def cmd_record_compile
	@ Command execution. Again, transfer this to the embedded expression
	and just forget the logical result.
	<<Commands: cmd record: TBP>>=
	procedure :: execute => cmd_record_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_record_execute (cmd, global)
	class(cmd_record_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_record_execute
	<<Commands: procedures>>=
	module subroutine cmd_record_execute (cmd, global)
	class(cmd_record_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	logical :: lval
	var_list => global%get_var_list_ptr ()
	lval = eval_log (cmd%pn_lexpr, var_list)
	end subroutine cmd_record_execute

	@ %def cmd_record_execute
	@
	\subsubsection{Unstable particles}
	Mark a particle as unstable. For each unstable particle, we store a
	number of decay channels and compute their respective BRs.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_unstable_t
	private
	integer :: n_proc = 0
	type(string_t), dimension(:), allocatable :: process_id
	type(parse_node_t), pointer :: pn_prt_in => null ()
	contains
	<<Commands: cmd unstable: TBP>>
	end type cmd_unstable_t

	@ %def cmd_unstable_t
	@ Output: we know the process IDs.
	<<Commands: cmd unstable: TBP>>=
	procedure :: write => cmd_unstable_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_unstable_write (cmd, unit, indent)
	class(cmd_unstable_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_unstable_write
	<<Commands: procedures>>=
	module subroutine cmd_unstable_write (cmd, unit, indent)
	class(cmd_unstable_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,I0,1x,A)", advance="no") &
	"unstable:", 1, "("
	do i = 1, cmd%n_proc
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (cmd%process_id(i))
	end do
	write (u, "(A)") ")"
	end subroutine cmd_unstable_write

	@ %def cmd_unstable_write
	@ Compile. Initiate an eval tree for the decaying particle and
	determine the decay channel process IDs.
	<<Commands: cmd unstable: TBP>>=
	procedure :: compile => cmd_unstable_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_unstable_compile (cmd, global)
	class(cmd_unstable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_unstable_compile
	<<Commands: procedures>>=
	module subroutine cmd_unstable_compile (cmd, global)
	class(cmd_unstable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_list, pn_proc
	integer :: i
	cmd%pn_prt_in => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_list => parse_node_get_next_ptr (cmd%pn_prt_in)
	if (associated (pn_list)) then
	select case (char (parse_node_get_rule_key (pn_list)))
	case ("unstable_arg")
	cmd%n_proc = parse_node_get_n_sub (pn_list)
	cmd%pn_opt => parse_node_get_next_ptr (pn_list)
	case default
	cmd%n_proc = 0
	cmd%pn_opt => pn_list
	pn_list => null ()
	end select
	end if
	call cmd%compile_options (global)
	if (associated (pn_list)) then
	allocate (cmd%process_id (cmd%n_proc))
	pn_proc => parse_node_get_sub_ptr (pn_list)
	do i = 1, cmd%n_proc
	cmd%process_id(i) = parse_node_get_string (pn_proc)
	call cmd%local%process_stack%init_result_vars (cmd%process_id(i))
	pn_proc => parse_node_get_next_ptr (pn_proc)
	end do
	else
	allocate (cmd%process_id (0))
	end if
	end subroutine cmd_unstable_compile

	@ %def cmd_unstable_compile
	@ Command execution. Evaluate the decaying particle and mark the decays in
	the current model object.
	<<Commands: cmd unstable: TBP>>=
	procedure :: execute => cmd_unstable_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_unstable_execute (cmd, global)
	class(cmd_unstable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_unstable_execute
	<<Commands: procedures>>=
	module subroutine cmd_unstable_execute (cmd, global)
	class(cmd_unstable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	logical :: auto_decays, auto_decays_radiative
	integer :: auto_decays_multiplicity
	logical :: isotropic_decay, diagonal_decay, polarized_decay
	integer :: decay_helicity
	type(pdg_array_t) :: pa_in
	integer :: pdg_in
	type(string_t) :: libname_cur, libname_dec
	type(string_t), dimension(:), allocatable :: auto_id, tmp_id
	integer :: n_proc_user
	integer :: i, u_tmp
	character(80) :: buffer
	var_list => cmd%local%get_var_list_ptr ()
	auto_decays = &
	var_list%get_lval (var_str ("?auto_decays"))
	if (auto_decays) then
	auto_decays_multiplicity = &
	var_list%get_ival (var_str ("auto_decays_multiplicity"))
	auto_decays_radiative = &
	var_list%get_lval (var_str ("?auto_decays_radiative"))
	end if
	isotropic_decay = &
	var_list%get_lval (var_str ("?isotropic_decay"))
	if (isotropic_decay) then
	diagonal_decay = .false.
	polarized_decay = .false.
	else
	diagonal_decay = &
	var_list%get_lval (var_str ("?diagonal_decay"))
	if (diagonal_decay) then
	polarized_decay = .false.
	else
	polarized_decay = &
	var_list%is_known (var_str ("decay_helicity"))
	if (polarized_decay) then
	decay_helicity = var_list%get_ival (var_str ("decay_helicity"))
	end if
	end if
	end if
	pa_in = eval_pdg_array (cmd%pn_prt_in, var_list)
	if (pa_in%get_length () /= 1) &
	call msg_fatal ("Unstable: decaying particle must be unique")
	pdg_in = pa_in%get (1)
	n_proc_user = cmd%n_proc
	if (auto_decays) then
	call create_auto_decays (pdg_in, &
	auto_decays_multiplicity, auto_decays_radiative, &
	libname_dec, auto_id, cmd%local)
	allocate (tmp_id (cmd%n_proc + size (auto_id)))
	tmp_id(:cmd%n_proc) = cmd%process_id
	tmp_id(cmd%n_proc+1:) = auto_id
	call move_alloc (from = tmp_id, to = cmd%process_id)
	cmd%n_proc = size (cmd%process_id)
	end if
	libname_cur = cmd%local%prclib%get_name ()
	do i = 1, cmd%n_proc
	if (i == n_proc_user + 1) then
	call cmd%local%update_prclib &
	(cmd%local%prclib_stack%get_library_ptr (libname_dec))
	end if
	if (.not. global%process_stack%exists (cmd%process_id(i))) then
	call var_list%set_log &
	(var_str ("?decay_rest_frame"), .false., is_known = .true.)
	call integrate_process (cmd%process_id(i), cmd%local, global)
	call global%process_stack%fill_result_vars (cmd%process_id(i))
	end if
	end do
	call cmd%local%update_prclib &
	(cmd%local%prclib_stack%get_library_ptr (libname_cur))
	if (cmd%n_proc > 0) then
	if (polarized_decay) then
	call global%modify_particle (pdg_in, stable = .false., &
	decay = cmd%process_id, &
	isotropic_decay = .false., &
	diagonal_decay = .false., &
	decay_helicity = decay_helicity, &
	polarized = .false.)
	else
	call global%modify_particle (pdg_in, stable = .false., &
	decay = cmd%process_id, &
	isotropic_decay = isotropic_decay, &
	diagonal_decay = diagonal_decay, &
	polarized = .false.)
	end if
	u_tmp = free_unit ()
	open (u_tmp, status = "scratch", action = "readwrite")
	call show_unstable (global, pdg_in, u_tmp)
	rewind (u_tmp)
	do
	read (u_tmp, "(A)", end = 1) buffer
	write (msg_buffer, "(A)") trim (buffer)
	call msg_message ()
	end do
	1 continue
	close (u_tmp)
	else
	call err_unstable (global, pdg_in)
	end if
	end subroutine cmd_unstable_execute

	@ %def cmd_unstable_execute
	@ Show data for the current unstable particle. This is called both by
	the [[unstable]] and by the [[show]] command.

	To determine decay branching rations, we look at the decay process IDs
	and inspect the corresponding [[integral()]] result variables.
	<<Commands: procedures>>=
	subroutine show_unstable (global, pdg, u)
	type(rt_data_t), intent(in), target :: global
	integer, intent(in) :: pdg, u
	type(flavor_t) :: flv
	type(string_t), dimension(:), allocatable :: decay
	real(default), dimension(:), allocatable :: br
	real(default) :: width
	type(process_t), pointer :: process
	type(process_component_def_t), pointer :: prc_def
	type(string_t), dimension(:), allocatable :: prt_out, prt_out_str
	integer :: i, j
	logical :: opened
	call flv%init (pdg, global%model)
	call flv%get_decays (decay)
	if (.not. allocated (decay)) return
	allocate (prt_out_str (size (decay)))
	allocate (br (size (decay)))
	do i = 1, size (br)
	process => global%process_stack%get_process_ptr (decay(i))
	prc_def => process%get_component_def_ptr (1)
	call prc_def%get_prt_out (prt_out)
	prt_out_str(i) = prt_out(1)
	do j = 2, size (prt_out)
	prt_out_str(i) = prt_out_str(i) // ", " // prt_out(j)
	end do
	br(i) = global%get_rval ("integral(" // decay(i) // ")")
	end do
	if (all (br >= 0)) then
	if (any (br > 0)) then
	width = sum (br)
	br = br / sum (br)
	write (u, "(A)") "Unstable particle " &
	// char (flv%get_name ()) &
	// ": computed branching ratios:"
	do i = 1, size (br)
	write (u, "(2x,A,':'," // FMT_14 // ",3x,A)") &
	char (decay(i)), br(i), char (prt_out_str(i))
	end do
	write (u, "(2x,'Total width ='," // FMT_14 // ",' GeV (computed)')") width
	write (u, "(2x,' ='," // FMT_14 // ",' GeV (preset)')") &
	flv%get_width ()
	if (flv%decays_isotropically ()) then
	write (u, "(2x,A)") "Decay options: isotropic"
	else if (flv%decays_diagonal ()) then
	write (u, "(2x,A)") "Decay options: &
	&projection on diagonal helicity states"
	else if (flv%has_decay_helicity ()) then
	write (u, "(2x,A,1x,I0)") "Decay options: projection onto helicity =", &
	flv%get_decay_helicity ()
	else
	write (u, "(2x,A)") "Decay options: helicity treated exactly"
	end if
	else
	inquire (unit = u, opened = opened)
	if (opened .and. .not. mask_fatal_errors) close (u)
	call msg_fatal ("Unstable particle " &
	// char (flv%get_name ()) &
	// ": partial width vanishes for all decay channels")
	end if
	else
	inquire (unit = u, opened = opened)
	if (opened .and. .not. mask_fatal_errors) close (u)
	call msg_fatal ("Unstable particle " &
	// char (flv%get_name ()) &
	// ": partial width is negative")
	end if
	end subroutine show_unstable

	@ %def show_unstable
	@ If no decays have been found, issue a non-fatal error.
	<<Commands: procedures>>=
	subroutine err_unstable (global, pdg)
	type(rt_data_t), intent(in), target :: global
	integer, intent(in) :: pdg
	type(flavor_t) :: flv
	call flv%init (pdg, global%model)
	call msg_error ("Unstable: no allowed decays found for particle " &
	// char (flv%get_name ()) // ", keeping as stable")
	end subroutine err_unstable

	@ %def err_unstable
	@ Auto decays: create process IDs and make up process
	configurations, using the PDG codes generated by the [[ds_table]] make
	method.

	We allocate and use a self-contained process library that contains only the
	decay processes of the current particle. When done, we revert the global
	library pointer to the original library but return the name of the new one.
	The new library becomes part of the global library stack and can thus be
	referred to at any time.
	<<Commands: procedures>>=
	subroutine create_auto_decays &
	(pdg_in, mult, rad, libname_dec, process_id, global)
	integer, intent(in) :: pdg_in
	integer, intent(in) :: mult
	logical, intent(in) :: rad
	type(string_t), intent(out) :: libname_dec
	type(string_t), dimension(:), allocatable, intent(out) :: process_id
	type(rt_data_t), intent(inout) :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	type(ds_table_t) :: ds_table
	type(split_constraints_t) :: constraints
	type(pdg_array_t), dimension(:), allocatable :: pa_out
	character(80) :: buffer
	character :: p_or_a
	type(string_t) :: process_string, libname_cur
	type(flavor_t) :: flv_in, flv_out
	type(string_t) :: prt_in
	type(string_t), dimension(:), allocatable :: prt_out
	type(process_configuration_t) :: prc_config
	integer :: i, j, k
	call flv_in%init (pdg_in, global%model)
	if (rad) then
	call constraints%init (2)
	else
	call constraints%init (3)
	call constraints%set (3, constrain_radiation ())
	end if
	call constraints%set (1, constrain_n_tot (mult))
	call constraints%set (2, &
	constrain_mass_sum (flv_in%get_mass (), margin = 0._default))
	call ds_table%make (global%model, pdg_in, constraints)
	prt_in = flv_in%get_name ()
	if (pdg_in > 0) then
	p_or_a = "p"
	else
	p_or_a = "a"
	end if
	if (ds_table%get_length () == 0) then
	call msg_warning ("Auto-decays: Particle " // char (prt_in) // ": " &
	// "no decays found")
	libname_dec = ""
	allocate (process_id (0))
	else
	call msg_message ("Creating decay process library for particle " &
	// char (prt_in))
	libname_cur = global%prclib%get_name ()
	write (buffer, "(A,A,I0)") "_d", p_or_a, abs (pdg_in)
	libname_dec = libname_cur // trim (buffer)
	lib => global%prclib_stack%get_library_ptr (libname_dec)
	if (.not. (associated (lib))) then
	allocate (lib_entry)
	call lib_entry%init (libname_dec)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)
	else
	call global%update_prclib (lib)
	end if
	allocate (process_id (ds_table%get_length ()))
	do i = 1, size (process_id)
	write (buffer, "(A,'_',A,I0,'_',I0)") &
	"decay", p_or_a, abs (pdg_in), i
	process_id(i) = trim (buffer)
	process_string = process_id(i) // ": " // prt_in // " =>"
	call ds_table%get_pdg_out (i, pa_out)
	allocate (prt_out (size (pa_out)))
	do j = 1, size (pa_out)
	do k = 1, pa_out(j)%get_length ()
	call flv_out%init (pa_out(j)%get (k), global%model)
	if (k == 1) then
	prt_out(j) = flv_out%get_name ()
	else
	prt_out(j) = prt_out(j) // ":" // flv_out%get_name ()
	end if
	end do
	process_string = process_string // " " // prt_out(j)
	end do
	call msg_message (char (process_string))
	call prc_config%init (process_id(i), 1, 1, &
	global%model, global%var_list, &
	nlo_process = global%nlo_fixed_order)
	call prc_config%setup_component (1, new_prt_spec ([prt_in]), &
	new_prt_spec (prt_out), global%model, global%var_list)
	call prc_config%record (global)
	deallocate (prt_out)
	deallocate (pa_out)
	end do
	lib => global%prclib_stack%get_library_ptr (libname_cur)
	call global%update_prclib (lib)
	end if
	call ds_table%final ()
	end subroutine create_auto_decays

	@ %def create_auto_decays
	@
	\subsubsection{(Stable particles}
	Revert the unstable declaration for a list of particles.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_stable_t
	private
	type(parse_node_p), dimension(:), allocatable :: pn_pdg
	contains
	<<Commands: cmd stable: TBP>>
	end type cmd_stable_t

	@ %def cmd_stable_t
	@ Output: we know only the number of particles.
	<<Commands: cmd stable: TBP>>=
	procedure :: write => cmd_stable_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_stable_write (cmd, unit, indent)
	class(cmd_stable_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_stable_write
	<<Commands: procedures>>=
	module subroutine cmd_stable_write (cmd, unit, indent)
	class(cmd_stable_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,I0)") "stable:", size (cmd%pn_pdg)
	end subroutine cmd_stable_write

	@ %def cmd_stable_write
	@ Compile. Assign parse nodes for the particle IDs.
	<<Commands: cmd stable: TBP>>=
	procedure :: compile => cmd_stable_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_stable_compile (cmd, global)
	class(cmd_stable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_stable_compile
	<<Commands: procedures>>=
	module subroutine cmd_stable_compile (cmd, global)
	class(cmd_stable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_list, pn_prt
	integer :: n, i
	pn_list => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_list)
	call cmd%compile_options (global)
	n = parse_node_get_n_sub (pn_list)
	allocate (cmd%pn_pdg (n))
	pn_prt => parse_node_get_sub_ptr (pn_list)
	i = 1
	do while (associated (pn_prt))
	cmd%pn_pdg(i)%ptr => pn_prt
	pn_prt => parse_node_get_next_ptr (pn_prt)
	i = i + 1
	end do
	end subroutine cmd_stable_compile

	@ %def cmd_stable_compile
	@ Execute: apply the modifications to the current model.
	<<Commands: cmd stable: TBP>>=
	procedure :: execute => cmd_stable_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_stable_execute (cmd, global)
	class(cmd_stable_t), intent(inout) :: cmd
	type(rt_data_t), target, intent(inout) :: global
	end subroutine cmd_stable_execute
	<<Commands: procedures>>=
	module subroutine cmd_stable_execute (cmd, global)
	class(cmd_stable_t), intent(inout) :: cmd
	type(rt_data_t), target, intent(inout) :: global
	type(var_list_t), pointer :: var_list
	type(pdg_array_t) :: pa
	integer :: pdg
	type(flavor_t) :: flv
	integer :: i
	var_list => cmd%local%get_var_list_ptr ()
	do i = 1, size (cmd%pn_pdg)
	pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
	if (pa%get_length () /= 1) &
	call msg_fatal ("Stable: listed particles must be unique")
	pdg = pa%get (1)
	call global%modify_particle (pdg, stable = .true., &
	isotropic_decay = .false., &
	diagonal_decay = .false., &
	polarized = .false.)
	call flv%init (pdg, cmd%local%model)
	call msg_message ("Particle " &
	// char (flv%get_name ()) &
	// " declared as stable")
	end do
	end subroutine cmd_stable_execute

	@ %def cmd_stable_execute
	@
	\subsubsection{Polarized particles}
	These commands mark particles as (un)polarized, to be applied in
	subsequent simulation passes. Since this is technically the same as
	the [[stable]] command, we take a shortcut and make this an extension,
	just overriding methods.
	<<Commands: types>>=
	type, extends (cmd_stable_t) :: cmd_polarized_t
	contains
	<<Commands: cmd polarized: TBP>>
	end type cmd_polarized_t

	type, extends (cmd_stable_t) :: cmd_unpolarized_t
	contains
	<<Commands: cmd unpolarized: TBP>>
	end type cmd_unpolarized_t

	@ %def cmd_polarized_t cmd_unpolarized_t
	@ Output: we know only the number of particles.
	<<Commands: cmd polarized: TBP>>=
	procedure :: write => cmd_polarized_write
	<<Commands: cmd unpolarized: TBP>>=
	procedure :: write => cmd_unpolarized_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_polarized_write (cmd, unit, indent)
	class(cmd_polarized_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_polarized_write
	module subroutine cmd_unpolarized_write (cmd, unit, indent)
	class(cmd_unpolarized_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_unpolarized_write
	<<Commands: procedures>>=
	module subroutine cmd_polarized_write (cmd, unit, indent)
	class(cmd_polarized_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,I0)") "polarized:", size (cmd%pn_pdg)
	end subroutine cmd_polarized_write

	module subroutine cmd_unpolarized_write (cmd, unit, indent)
	class(cmd_unpolarized_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,I0)") "unpolarized:", size (cmd%pn_pdg)
	end subroutine cmd_unpolarized_write

	@ %def cmd_polarized_write
	@ %def cmd_unpolarized_write
	@ Compile: accounted for by the base command.

	Execute: apply the modifications to the current model.
	<<Commands: cmd polarized: TBP>>=
	procedure :: execute => cmd_polarized_execute
	<<Commands: cmd unpolarized: TBP>>=
	procedure :: execute => cmd_unpolarized_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_polarized_execute (cmd, global)
	class(cmd_polarized_t), intent(inout) :: cmd
	type(rt_data_t), target, intent(inout) :: global
	end subroutine cmd_polarized_execute
	module subroutine cmd_unpolarized_execute (cmd, global)
	class(cmd_unpolarized_t), intent(inout) :: cmd
	type(rt_data_t), target, intent(inout) :: global
	end subroutine cmd_unpolarized_execute
	<<Commands: procedures>>=
	module subroutine cmd_polarized_execute (cmd, global)
	class(cmd_polarized_t), intent(inout) :: cmd
	type(rt_data_t), target, intent(inout) :: global
	type(var_list_t), pointer :: var_list
	type(pdg_array_t) :: pa
	integer :: pdg
	type(flavor_t) :: flv
	integer :: i
	var_list => cmd%local%get_var_list_ptr ()
	do i = 1, size (cmd%pn_pdg)
	pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
	if (pa%get_length () /= 1) &
	call msg_fatal ("Polarized: listed particles must be unique")
	pdg = pa%get (1)
	call global%modify_particle (pdg, polarized = .true., &
	stable = .true., &
	isotropic_decay = .false., &
	diagonal_decay = .false.)
	call flv%init (pdg, cmd%local%model)
	call msg_message ("Particle " &
	// char (flv%get_name ()) &
	// " declared as polarized")
	end do
	end subroutine cmd_polarized_execute

	module subroutine cmd_unpolarized_execute (cmd, global)
	class(cmd_unpolarized_t), intent(inout) :: cmd
	type(rt_data_t), target, intent(inout) :: global
	type(var_list_t), pointer :: var_list
	type(pdg_array_t) :: pa
	integer :: pdg
	type(flavor_t) :: flv
	integer :: i
	var_list => cmd%local%get_var_list_ptr ()
	do i = 1, size (cmd%pn_pdg)
	pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
	if (pa%get_length () /= 1) &
	call msg_fatal ("Unpolarized: listed particles must be unique")
	pdg = pa%get (1)
	call global%modify_particle (pdg, polarized = .false., &
	stable = .true., &
	isotropic_decay = .false., &
	diagonal_decay = .false.)
	call flv%init (pdg, cmd%local%model)
	call msg_message ("Particle " &
	// char (flv%get_name ()) &
	// " declared as unpolarized")
	end do
	end subroutine cmd_unpolarized_execute

	@ %def cmd_polarized_execute
	@ %def cmd_unpolarized_execute
	@
	\subsubsection{Parameters: formats for event-sample output}
	Specify all event formats that are to be used for output files in the
	subsequent simulation run. (The raw format is on by default and can be turned
	off here.)
	<<Commands: types>>=
	type, extends (command_t) :: cmd_sample_format_t
	private
	type(string_t), dimension(:), allocatable :: format
	contains
	<<Commands: cmd sample format: TBP>>
	end type cmd_sample_format_t

	@ %def cmd_sample_format_t
	@ Output: here, everything is known.
	<<Commands: cmd sample format: TBP>>=
	procedure :: write => cmd_sample_format_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_sample_format_write (cmd, unit, indent)
	class(cmd_sample_format_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_sample_format_write
	<<Commands: procedures>>=
	module subroutine cmd_sample_format_write (cmd, unit, indent)
	class(cmd_sample_format_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "sample_format = "
	do i = 1, size (cmd%format)
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (cmd%format(i))
	end do
	write (u, "(A)")
	end subroutine cmd_sample_format_write

	@ %def cmd_sample_format_write
	@ Compile. Initialize evaluation trees.
	<<Commands: cmd sample format: TBP>>=
	procedure :: compile => cmd_sample_format_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_sample_format_compile (cmd, global)
	class(cmd_sample_format_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_sample_format_compile
	<<Commands: procedures>>=
	module subroutine cmd_sample_format_compile (cmd, global)
	class(cmd_sample_format_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg
	type(parse_node_t), pointer :: pn_format
	integer :: i, n_format
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
	if (associated (pn_arg)) then
	n_format = parse_node_get_n_sub (pn_arg)
	allocate (cmd%format (n_format))
	pn_format => parse_node_get_sub_ptr (pn_arg)
	i = 0
	do while (associated (pn_format))
	i = i + 1
	cmd%format(i) = parse_node_get_string (pn_format)
	pn_format => parse_node_get_next_ptr (pn_format)
	end do
	else
	allocate (cmd%format (0))
	end if
	end subroutine cmd_sample_format_compile

	@ %def cmd_sample_format_compile
	@ Execute. Transfer the list of format specifications to the
	corresponding array in the runtime data set.
	<<Commands: cmd sample format: TBP>>=
	procedure :: execute => cmd_sample_format_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_sample_format_execute (cmd, global)
	class(cmd_sample_format_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_sample_format_execute
	<<Commands: procedures>>=
	module subroutine cmd_sample_format_execute (cmd, global)
	class(cmd_sample_format_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (allocated (global%sample_fmt)) deallocate (global%sample_fmt)
	allocate (global%sample_fmt (size (cmd%format)), source = cmd%format)
	end subroutine cmd_sample_format_execute

	@ %def cmd_sample_format_execute
	@
	\subsubsection{The simulate command}
	This is the actual SINDARIN command.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_simulate_t
	! not private anymore as required by the whizard-c-interface
	integer :: n_proc = 0
	type(string_t), dimension(:), allocatable :: process_id
	contains
	<<Commands: cmd simulate: TBP>>
	end type cmd_simulate_t

	@ %def cmd_simulate_t
	@ Output: we know the process IDs.
	<<Commands: cmd simulate: TBP>>=
	procedure :: write => cmd_simulate_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_simulate_write (cmd, unit, indent)
	class(cmd_simulate_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_simulate_write
	<<Commands: procedures>>=
	module subroutine cmd_simulate_write (cmd, unit, indent)
	class(cmd_simulate_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "simulate ("
	do i = 1, cmd%n_proc
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (cmd%process_id(i))
	end do
	write (u, "(A)") ")"
	end subroutine cmd_simulate_write

	@ %def cmd_simulate_write
	@ Compile. In contrast to WHIZARD 1 the confusing option to give the
	number of unweighted events for weighted events as if unweighting were
	to take place has been abandoned. (We both use [[n_events]] for
	weighted and unweighted events, the variable [[n_calls]] from WHIZARD
	1 has been discarded.
	<<Commands: cmd simulate: TBP>>=
	procedure :: compile => cmd_simulate_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_simulate_compile (cmd, global)
	class(cmd_simulate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_simulate_compile
	<<Commands: procedures>>=
	module subroutine cmd_simulate_compile (cmd, global)
	class(cmd_simulate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_proclist, pn_proc
	integer :: i
	pn_proclist => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
	call cmd%compile_options (global)
	cmd%n_proc = parse_node_get_n_sub (pn_proclist)
	allocate (cmd%process_id (cmd%n_proc))
	pn_proc => parse_node_get_sub_ptr (pn_proclist)
	do i = 1, cmd%n_proc
	cmd%process_id(i) = parse_node_get_string (pn_proc)
	call global%process_stack%init_result_vars (cmd%process_id(i))
	pn_proc => parse_node_get_next_ptr (pn_proc)
	end do
	end subroutine cmd_simulate_compile

	@ %def cmd_simulate_compile
	@ Execute command: Simulate events. This is done via a [[simulation_t]]
	object and its associated methods.

	Signal handling: the [[generate]] method may exit abnormally if there is a
	pending signal. The current logic ensures that the [[es_array]] output
	channels are closed before the [[execute]] routine returns. The program will
	terminate then in [[command_list_execute]].
	<<Commands: cmd simulate: TBP>>=
	procedure :: execute => cmd_simulate_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_simulate_execute (cmd, global)
	class(cmd_simulate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_simulate_execute
	<<Commands: procedures>>=
	module subroutine cmd_simulate_execute (cmd, global)
	class(cmd_simulate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(rt_data_t), dimension(:), allocatable, target :: alt_env
	integer :: n_events
	type(simulation_t), target :: sim
	type(event_stream_array_t) :: es_array
	integer :: i, checkpoint, callback
	var_list => cmd%local%var_list
	if (cmd%local%nlo_fixed_order) then
	call check_nlo_options (cmd%local)
	end if
	if (allocated (cmd%local%pn%alt_setup)) then
	allocate (alt_env (size (cmd%local%pn%alt_setup)))
	do i = 1, size (alt_env)
	call build_alt_setup (alt_env(i), cmd%local, &
	cmd%local%pn%alt_setup(i)%ptr)
	end do
	call sim%init (cmd%process_id, .true., .true., cmd%local, global, &
	alt_env)
	else
	call sim%init (cmd%process_id, .true., .true., cmd%local, global)
	end if
	if (signal_is_pending ()) return
	if (sim%is_valid ()) then
	call sim%init_process_selector ()
	call sim%setup_openmp ()
	call sim%compute_n_events (n_events)
	call sim%set_n_events_requested (n_events)
	call sim%activate_extra_logging ()
	call sim%prepare_event_streams (es_array)
	if (es_array%is_valid ()) then
	call sim%generate (es_array)
	else
	call sim%generate ()
	end if
	call es_array%final ()
	if (allocated (alt_env)) then
	do i = 1, size (alt_env)
	call alt_env(i)%local_final ()
	end do
	end if
	end if
	call sim%final ()
	end subroutine cmd_simulate_execute

	@ %def cmd_simulate_execute
	@ Build an alternative setup: the parse tree is stored in the global
	environment. We create a temporary command list to compile and execute this;
	the result is an alternative local environment [[alt_env]] which we can hand
	over to the [[simulate]] command.
	<<Commands: procedures>>=
	recursive subroutine build_alt_setup (alt_env, global, pn)
	type(rt_data_t), intent(inout), target :: alt_env
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), intent(in), target :: pn
	type(command_list_t), allocatable :: alt_options
	allocate (alt_options)
	call alt_env%local_init (global)
	call alt_env%activate ()
	call alt_options%compile (pn, alt_env)
	call alt_options%execute (alt_env)
	call alt_env%deactivate (global, keep_local = .true.)
	call alt_options%final ()
	end subroutine build_alt_setup

	@ %def build_alt_setup
	@
	\subsubsection{The rescan command}
	This is the actual SINDARIN command.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_rescan_t
	! private
	type(parse_node_t), pointer :: pn_filename => null ()
	integer :: n_proc = 0
	type(string_t), dimension(:), allocatable :: process_id
	contains
	<<Commands: cmd rescan: TBP>>
	end type cmd_rescan_t

	@ %def cmd_rescan_t
	@ Output: we know the process IDs.
	<<Commands: cmd rescan: TBP>>=
	procedure :: write => cmd_rescan_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_rescan_write (cmd, unit, indent)
	class(cmd_rescan_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_rescan_write
	<<Commands: procedures>>=
	module subroutine cmd_rescan_write (cmd, unit, indent)
	class(cmd_rescan_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "rescan ("
	do i = 1, cmd%n_proc
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (cmd%process_id(i))
	end do
	write (u, "(A)") ")"
	end subroutine cmd_rescan_write

	@ %def cmd_rescan_write
	@ Compile. The command takes a suffix argument, namely the file name
	of requested event file.
	<<Commands: cmd rescan: TBP>>=
	procedure :: compile => cmd_rescan_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_rescan_compile (cmd, global)
	class(cmd_rescan_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_rescan_compile
	<<Commands: procedures>>=
	module subroutine cmd_rescan_compile (cmd, global)
	class(cmd_rescan_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_filename, pn_proclist, pn_proc
	integer :: i
	pn_filename => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_proclist => parse_node_get_next_ptr (pn_filename)
	cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
	call cmd%compile_options (global)
	cmd%pn_filename => pn_filename
	cmd%n_proc = parse_node_get_n_sub (pn_proclist)
	allocate (cmd%process_id (cmd%n_proc))
	pn_proc => parse_node_get_sub_ptr (pn_proclist)
	do i = 1, cmd%n_proc
	cmd%process_id(i) = parse_node_get_string (pn_proc)
	pn_proc => parse_node_get_next_ptr (pn_proc)
	end do
	end subroutine cmd_rescan_compile

	@ %def cmd_rescan_compile
	@ Execute command: Rescan events. This is done via a [[simulation_t]]
	object and its associated methods.
	<<Commands: cmd rescan: TBP>>=
	procedure :: execute => cmd_rescan_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_rescan_execute (cmd, global)
	class(cmd_rescan_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_rescan_execute
	<<Commands: procedures>>=
	module subroutine cmd_rescan_execute (cmd, global)
	class(cmd_rescan_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(rt_data_t), dimension(:), allocatable, target :: alt_env
	type(string_t) :: sample, sample_suffix
	logical :: exist, write_raw, update_event, update_sqme
	type(simulation_t), target :: sim
	type(event_sample_data_t) :: input_data, data
	type(string_t) :: input_sample
	integer :: n_fmt
	type(string_t), dimension(:), allocatable :: sample_fmt
	type(string_t) :: input_format, input_ext, input_file
	type(string_t) :: lhef_extension, extension_hepmc, extension_lcio
	type(event_stream_array_t) :: es_array
	integer :: i, n_events
	<<Commands: cmd rescan execute: extra variables>>
	var_list => cmd%local%var_list
	if (allocated (cmd%local%pn%alt_setup)) then
	allocate (alt_env (size (cmd%local%pn%alt_setup)))
	do i = 1, size (alt_env)
	call build_alt_setup (alt_env(i), cmd%local, &
	cmd%local%pn%alt_setup(i)%ptr)
	end do
	call sim%init (cmd%process_id, .false., .false., cmd%local, global, &
	alt_env)
	else
	call sim%init (cmd%process_id, .false., .false., cmd%local, global)
	end if
	call sim%compute_n_events (n_events)
	input_sample = eval_string (cmd%pn_filename, var_list)
	input_format = var_list%get_sval (&
	var_str ("$rescan_input_format"))
	sample_suffix = ""
	<<Commands: cmd rescan execute: extra init>>
	sample = var_list%get_sval (var_str ("$sample"))
	if (sample == "") then
	sample = sim%get_default_sample_name () // sample_suffix
	else
	sample = var_list%get_sval (var_str ("$sample")) // sample_suffix
	end if
	write_raw = var_list%get_lval (var_str ("?write_raw"))
	if (allocated (cmd%local%sample_fmt)) then
	n_fmt = size (cmd%local%sample_fmt)
	else
	n_fmt = 0
	end if
	if (write_raw) then
	if (sample == input_sample) then
	call msg_error ("Rescan: ?write_raw = true: " &
	// "suppressing raw event output (filename clashes with input)")
	allocate (sample_fmt (n_fmt))
	if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
	else
	allocate (sample_fmt (n_fmt + 1))
	if (n_fmt > 0) sample_fmt(:n_fmt) = cmd%local%sample_fmt
	sample_fmt(n_fmt+1) = var_str ("raw")
	end if
	else
	allocate (sample_fmt (n_fmt))
	if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
	end if
	update_event = &
	var_list%get_lval (var_str ("?update_event"))
	update_sqme = &
	var_list%get_lval (var_str ("?update_sqme"))
	if (update_event .or. update_sqme) then
	call msg_message ("Recalculating observables")
	if (update_sqme) then
	call msg_message ("Recalculating squared matrix elements")
	end if
	end if
	lhef_extension = &
	var_list%get_sval (var_str ("$lhef_extension"))
	extension_hepmc = &
	var_list%get_sval (var_str ("$extension_hepmc"))
	extension_lcio = &
	var_list%get_sval (var_str ("$extension_lcio"))
	select case (char (input_format))
	case ("raw"); input_ext = "evx"
	call cmd%local%set_log &
	(var_str ("?recover_beams"), .false., is_known=.true.)
	case ("lhef"); input_ext = lhef_extension
	case ("hepmc"); input_ext = extension_hepmc
	case ("lcio"); input_ext = extension_lcio
	case default
	call msg_fatal ("rescan: input sample format '" // char (input_format) &
	// "' not supported")
	end select
	input_file = input_sample // "." // input_ext
	inquire (file = char (input_file), exist = exist)
	if (exist) then
	input_data = sim%get_data (alt = .false.)
	input_data%n_evt = n_events
	data = sim%get_data ()
	data%n_evt = n_events
	input_data%md5sum_cfg = ""
	call es_array%init (sample, &
	sample_fmt, cmd%local, data, &
	input = input_format, input_sample = input_sample, &
	input_data = input_data, &
	allow_switch = .false.)
	call sim%rescan (n_events, es_array, global = cmd%local)
	call es_array%final ()
	else
	call msg_fatal ("Rescan: event file '" &
	// char (input_file) // "' not found")
	end if
	if (allocated (alt_env)) then
	do i = 1, size (alt_env)
	call alt_env(i)%local_final ()
	end do
	end if
	call sim%final ()
	end subroutine cmd_rescan_execute

	@ %def cmd_rescan_execute
	@ MPI: Append rank id to sample name.
	<<Commands: cmd rescan execute: extra variables>>=
	<<MPI: Commands: cmd rescan execute: extra variables>>=
	logical :: mpi_logging
	integer :: rank, n_size
	<<Commands: cmd rescan execute: extra init>>=
	<<MPI: Commands: cmd rescan execute: extra init>>=
	call mpi_get_comm_id (n_size, rank)
	if (n_size > 1) then
	sample_suffix = var_str ("_") // str (rank)
	end if
	mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) &
	& .and. (n_size > 1)) &
	& .or. var_list%get_lval (var_str ("?mpi_logging")))
	call mpi_set_logging (mpi_logging)
	@
	\subsubsection{Parameters: number of iterations}
	Specify number of iterations and number of calls for one integration pass.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_iterations_t
	private
	integer :: n_pass = 0
	type(parse_node_p), dimension(:), allocatable :: pn_expr_n_it
	type(parse_node_p), dimension(:), allocatable :: pn_expr_n_calls
	type(parse_node_p), dimension(:), allocatable :: pn_sexpr_adapt
	contains
	<<Commands: cmd iterations: TBP>>
	end type cmd_iterations_t

	@ %def cmd_iterations_t
	@ Output. Display the number of passes, which is known after compilation.
	<<Commands: cmd iterations: TBP>>=
	procedure :: write => cmd_iterations_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_iterations_write (cmd, unit, indent)
	class(cmd_iterations_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_iterations_write
	<<Commands: procedures>>=
	module subroutine cmd_iterations_write (cmd, unit, indent)
	class(cmd_iterations_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_pass)
	case (0)
	write (u, "(1x,A)") "iterations: [empty]"
	case (1)
	write (u, "(1x,A,I0,A)") "iterations: ", cmd%n_pass, " pass"
	case default
	write (u, "(1x,A,I0,A)") "iterations: ", cmd%n_pass, " passes"
	end select
	end subroutine cmd_iterations_write

	@ %def cmd_iterations_write
	@ Compile. Initialize evaluation trees.
	<<Commands: cmd iterations: TBP>>=
	procedure :: compile => cmd_iterations_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_iterations_compile (cmd, global)
	class(cmd_iterations_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_iterations_compile
	<<Commands: procedures>>=
	module subroutine cmd_iterations_compile (cmd, global)
	class(cmd_iterations_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_n_it, pn_n_calls, pn_adapt
	type(parse_node_t), pointer :: pn_it_spec, pn_calls_spec, pn_adapt_spec
	integer :: i
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
	if (associated (pn_arg)) then
	cmd%n_pass = parse_node_get_n_sub (pn_arg)
	allocate (cmd%pn_expr_n_it (cmd%n_pass))
	allocate (cmd%pn_expr_n_calls (cmd%n_pass))
	allocate (cmd%pn_sexpr_adapt (cmd%n_pass))
	pn_it_spec => parse_node_get_sub_ptr (pn_arg)
	i = 1
	do while (associated (pn_it_spec))
	pn_n_it => parse_node_get_sub_ptr (pn_it_spec)
	pn_calls_spec => parse_node_get_next_ptr (pn_n_it)
	pn_n_calls => parse_node_get_sub_ptr (pn_calls_spec, 2)
	pn_adapt_spec => parse_node_get_next_ptr (pn_calls_spec)
	if (associated (pn_adapt_spec)) then
	pn_adapt => parse_node_get_sub_ptr (pn_adapt_spec, 2)
	else
	pn_adapt => null ()
	end if
	cmd%pn_expr_n_it(i)%ptr => pn_n_it
	cmd%pn_expr_n_calls(i)%ptr => pn_n_calls
	cmd%pn_sexpr_adapt(i)%ptr => pn_adapt
	i = i + 1
	pn_it_spec => parse_node_get_next_ptr (pn_it_spec)
	end do
	else
	allocate (cmd%pn_expr_n_it (0))
	allocate (cmd%pn_expr_n_calls (0))
	end if
	end subroutine cmd_iterations_compile

	@ %def cmd_iterations_compile
	@ Execute. Evaluate the trees and transfer the results to the iteration
	list in the runtime data set.
	<<Commands: cmd iterations: TBP>>=
	procedure :: execute => cmd_iterations_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_iterations_execute (cmd, global)
	class(cmd_iterations_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_iterations_execute
	<<Commands: procedures>>=
	module subroutine cmd_iterations_execute (cmd, global)
	class(cmd_iterations_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	integer, dimension(cmd%n_pass) :: n_it, n_calls
	logical, dimension(cmd%n_pass) :: custom_adapt
	type(string_t), dimension(cmd%n_pass) :: adapt_code
	integer :: i
	var_list => global%get_var_list_ptr ()
	do i = 1, cmd%n_pass
	n_it(i) = eval_int (cmd%pn_expr_n_it(i)%ptr, var_list)
	n_calls(i) = &
	eval_int (cmd%pn_expr_n_calls(i)%ptr, var_list)
	if (associated (cmd%pn_sexpr_adapt(i)%ptr)) then
	adapt_code(i) = &
	eval_string (cmd%pn_sexpr_adapt(i)%ptr, &
	var_list, is_known = custom_adapt(i))
	else
	custom_adapt(i) = .false.
	end if
	end do
	call global%it_list%init (n_it, n_calls, custom_adapt, adapt_code)
	end subroutine cmd_iterations_execute

	@ %def cmd_iterations_execute
	@
	\subsubsection{Range expressions}
	We need a special type for storing and evaluating range expressions.
	<<Commands: parameters>>=
	integer, parameter :: STEP_NONE = 0
	integer, parameter :: STEP_ADD = 1
	integer, parameter :: STEP_SUB = 2
	integer, parameter :: STEP_MUL = 3
	integer, parameter :: STEP_DIV = 4
	integer, parameter :: STEP_COMP_ADD = 11
	integer, parameter :: STEP_COMP_MUL = 13
	@
	There is an abstract base type and two implementations: scan over integers and
	scan over reals.
	<<Commands: types>>=
	type, abstract :: range_t
	type(parse_node_t), pointer :: pn_expr => null ()
	type(parse_node_t), pointer :: pn_term => null ()
	type(parse_node_t), pointer :: pn_factor => null ()
	type(parse_node_t), pointer :: pn_value => null ()
	type(parse_node_t), pointer :: pn_literal => null ()
	type(parse_node_t), pointer :: pn_beg => null ()
	type(parse_node_t), pointer :: pn_end => null ()
	type(parse_node_t), pointer :: pn_step => null ()
	type(eval_tree_t) :: expr_beg
	type(eval_tree_t) :: expr_end
	type(eval_tree_t) :: expr_step
	integer :: step_mode = 0
	integer :: n_step = 0
	contains
	<<Commands: range: TBP>>
	end type range_t

	@ %def range_t
	@ These are the implementations:
	<<Commands: types>>=
	type, extends (range_t) :: range_int_t
	integer :: i_beg = 0
	integer :: i_end = 0
	integer :: i_step = 0
	contains
	<<Commands: range int: TBP>>
	end type range_int_t

	type, extends (range_t) :: range_real_t
	real(default) :: r_beg = 0
	real(default) :: r_end = 0
	real(default) :: r_step = 0
	real(default) :: lr_beg = 0
	real(default) :: lr_end = 0
	real(default) :: lr_step = 0
	contains
	<<Commands: range real: TBP>>
	end type range_real_t

	@ %def range_int_t range_real_t
	@ Finalize the allocated dummy node. The other nodes are just pointers.
	<<Commands: range: TBP>>=
	procedure :: final => range_final
	<<Commands: sub interfaces>>=
	module subroutine range_final (object)
	class(range_t), intent(inout) :: object
	end subroutine range_final
	<<Commands: procedures>>=
	module subroutine range_final (object)
	class(range_t), intent(inout) :: object
	if (associated (object%pn_expr)) then
	call parse_node_final (object%pn_expr, recursive = .false.)
	call parse_node_final (object%pn_term, recursive = .false.)
	call parse_node_final (object%pn_factor, recursive = .false.)
	call parse_node_final (object%pn_value, recursive = .false.)
	call parse_node_final (object%pn_literal, recursive = .false.)
	deallocate (object%pn_expr)
	deallocate (object%pn_term)
	deallocate (object%pn_factor)
	deallocate (object%pn_value)
	deallocate (object%pn_literal)
	end if
	end subroutine range_final

	@ %def range_final
	@ Output.
	<<Commands: range: TBP>>=
	procedure (range_write), deferred :: write
	procedure :: base_write => range_write
	<<Commands: range int: TBP>>=
	procedure :: write => range_int_write
	<<Commands: range real: TBP>>=
	procedure :: write => range_real_write
	<<Commands: sub interfaces>>=
	module subroutine range_write (object, unit)
	class(range_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine range_write
	module subroutine range_int_write (object, unit)
	class(range_int_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine range_int_write
	module subroutine range_real_write (object, unit)
	class(range_real_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine range_real_write
	<<Commands: procedures>>=
	module subroutine range_write (object, unit)
	class(range_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Range specification:"
	if (associated (object%pn_expr)) then
	write (u, "(1x,A)") "Dummy value:"
	call parse_node_write_rec (object%pn_expr, u)
	end if
	if (associated (object%pn_beg)) then
	write (u, "(1x,A)") "Initial value:"
	call parse_node_write_rec (object%pn_beg, u)
	call object%expr_beg%write (u)
	if (associated (object%pn_end)) then
	write (u, "(1x,A)") "Final value:"
	call parse_node_write_rec (object%pn_end, u)
	call object%expr_end%write (u)
	if (associated (object%pn_step)) then
	write (u, "(1x,A)") "Step value:"
	call parse_node_write_rec (object%pn_step, u)
	select case (object%step_mode)
	case (STEP_ADD); write (u, "(1x,A)") "Step mode: +"
	case (STEP_SUB); write (u, "(1x,A)") "Step mode: -"
	case (STEP_MUL); write (u, "(1x,A)") "Step mode: *"
	case (STEP_DIV); write (u, "(1x,A)") "Step mode: /"
	case (STEP_COMP_ADD); write (u, "(1x,A)") "Division mode: +"
	case (STEP_COMP_MUL); write (u, "(1x,A)") "Division mode: *"
	end select
	end if
	end if
	else
	write (u, "(1x,A)") "Expressions: [undefined]"
	end if
	end subroutine range_write

	module subroutine range_int_write (object, unit)
	class(range_int_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call object%base_write (unit)
	write (u, "(1x,A)") "Range parameters:"
	write (u, "(3x,A,I0)") "i_beg = ", object%i_beg
	write (u, "(3x,A,I0)") "i_end = ", object%i_end
	write (u, "(3x,A,I0)") "i_step = ", object%i_step
	write (u, "(3x,A,I0)") "n_step = ", object%n_step
	end subroutine range_int_write

	module subroutine range_real_write (object, unit)
	class(range_real_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call object%base_write (unit)
	write (u, "(1x,A)") "Range parameters:"
	write (u, "(3x,A," // FMT_19 // ")") "r_beg = ", object%r_beg
	write (u, "(3x,A," // FMT_19 // ")") "r_end = ", object%r_end
	write (u, "(3x,A," // FMT_19 // ")") "r_step = ", object%r_end
	write (u, "(3x,A,I0)") "n_step = ", object%n_step
	end subroutine range_real_write

	@ %def range_write
	@ Initialize, given a range expression parse node. This is common to the
	implementations.
	<<Commands: range: TBP>>=
	procedure :: init => range_init
	<<Commands: sub interfaces>>=
	module subroutine range_init (range, pn)
	class(range_t), intent(out) :: range
	type(parse_node_t), intent(in), target :: pn
	end subroutine range_init
	<<Commands: procedures>>=
	module subroutine range_init (range, pn)
	class(range_t), intent(out) :: range
	type(parse_node_t), intent(in), target :: pn
	type(parse_node_t), pointer :: pn_spec, pn_end, pn_step_spec, pn_op
	select case (char (parse_node_get_rule_key (pn)))
	case ("expr")
	case ("range_expr")
	range%pn_beg => parse_node_get_sub_ptr (pn)
	pn_spec => parse_node_get_next_ptr (range%pn_beg)
	if (associated (pn_spec)) then
	pn_end => parse_node_get_sub_ptr (pn_spec, 2)
	range%pn_end => pn_end
	pn_step_spec => parse_node_get_next_ptr (pn_end)
	if (associated (pn_step_spec)) then
	pn_op => parse_node_get_sub_ptr (pn_step_spec)
	range%pn_step => parse_node_get_next_ptr (pn_op)
	select case (char (parse_node_get_rule_key (pn_op)))
	case ("/+"); range%step_mode = STEP_ADD
	case ("/-"); range%step_mode = STEP_SUB
	case ("/*"); range%step_mode = STEP_MUL
	case ("//"); range%step_mode = STEP_DIV
	case ("/+/"); range%step_mode = STEP_COMP_ADD
	case ("/*/"); range%step_mode = STEP_COMP_MUL
	case default
	call range%write ()
	call msg_bug ("Range: step mode not implemented")
	end select
	else
	range%step_mode = STEP_ADD
	end if
	else
	range%step_mode = STEP_NONE
	end if
	call range%create_value_node ()
	case default
	call msg_bug ("range expression: node type '" &
	// char (parse_node_get_rule_key (pn)) &
	// "' not implemented")
	end select
	end subroutine range_init

	@ %def range_init
	@ This method manually creates a parse node (actually, a cascade of parse
	nodes) that hold a constant value as a literal. The idea is that this node is
	inserted as the right-hand side of a fake variable assignment, which is
	prepended to each scan iteration. Before the variable
	assignment is compiled and executed, we can manually reset the value of the
	literal and thus pretend that the loop variable is assigned this value.
	<<Commands: range: TBP>>=
	procedure :: create_value_node => range_create_value_node
	<<Commands: sub interfaces>>=
	module subroutine range_create_value_node (range)
	class(range_t), intent(inout) :: range
	end subroutine range_create_value_node
	<<Commands: procedures>>=
	module subroutine range_create_value_node (range)
	class(range_t), intent(inout) :: range
	allocate (range%pn_literal)
	allocate (range%pn_value)
	select type (range)
	type is (range_int_t)
	call parse_node_create_value (range%pn_literal, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("integer_literal")),&
	ival = 0)
	call parse_node_create_branch (range%pn_value, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("integer_value")))
	type is (range_real_t)
	call parse_node_create_value (range%pn_literal, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("real_literal")),&
	rval = 0._default)
	call parse_node_create_branch (range%pn_value, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("real_value")))
	class default
	call msg_bug ("range: create value node: type not implemented")
	end select
	call parse_node_append_sub (range%pn_value, range%pn_literal)
	call parse_node_freeze_branch (range%pn_value)
	allocate (range%pn_factor)
	call parse_node_create_branch (range%pn_factor, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("factor")))
	call parse_node_append_sub (range%pn_factor, range%pn_value)
	call parse_node_freeze_branch (range%pn_factor)
	allocate (range%pn_term)
	call parse_node_create_branch (range%pn_term, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("term")))
	call parse_node_append_sub (range%pn_term, range%pn_factor)
	call parse_node_freeze_branch (range%pn_term)
	allocate (range%pn_expr)
	call parse_node_create_branch (range%pn_expr, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("expr")))
	call parse_node_append_sub (range%pn_expr, range%pn_term)
	call parse_node_freeze_branch (range%pn_expr)
	end subroutine range_create_value_node

	@ %def range_create_value_node
	@ Compile, given an environment.
	<<Commands: range: TBP>>=
	procedure :: compile => range_compile
	<<Commands: sub interfaces>>=
	module subroutine range_compile (range, global)
	class(range_t), intent(inout) :: range
	type(rt_data_t), intent(in), target :: global
	end subroutine range_compile
	<<Commands: procedures>>=
	module subroutine range_compile (range, global)
	class(range_t), intent(inout) :: range
	type(rt_data_t), intent(in), target :: global
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	if (associated (range%pn_beg)) then
	call range%expr_beg%init_expr (range%pn_beg, var_list)
	if (associated (range%pn_end)) then
	call range%expr_end%init_expr (range%pn_end, var_list)
	if (associated (range%pn_step)) then
	call range%expr_step%init_expr (range%pn_step, var_list)
	end if
	end if
	end if
	end subroutine range_compile

	@ %def range_compile
	@ Evaluate: compute the actual bounds and parameters that determine the values
	that we can iterate.

	This is implementation-specific.
	<<Commands: range: TBP>>=
	procedure (range_evaluate), deferred :: evaluate
	<<Commands: interfaces>>=
	abstract interface
	subroutine range_evaluate (range)
	import
	class(range_t), intent(inout) :: range
	end subroutine range_evaluate
	end interface

	@ %def range_evaluate
	@ The version for an integer variable. If the step is subtractive, we invert
	the sign and treat it as an additive step. For a multiplicative step, the
	step must be greater than one, and the initial and final values must be of
	same sign and strictly ordered. Analogously for a division step.
	<<Commands: range int: TBP>>=
	procedure :: evaluate => range_int_evaluate
	<<Commands: sub interfaces>>=
	module subroutine range_int_evaluate (range)
	class(range_int_t), intent(inout) :: range
	end subroutine range_int_evaluate
	<<Commands: procedures>>=
	module subroutine range_int_evaluate (range)
	class(range_int_t), intent(inout) :: range
	integer :: ival
	if (associated (range%pn_beg)) then
	call range%expr_beg%evaluate ()
	if (range%expr_beg%is_known ()) then
	range%i_beg = range%expr_beg%get_int ()
	else
	call range%write ()
	call msg_fatal &
	("Range expression: initial value evaluates to unknown")
	end if
	if (associated (range%pn_end)) then
	call range%expr_end%evaluate ()
	if (range%expr_end%is_known ()) then
	range%i_end = range%expr_end%get_int ()
	if (associated (range%pn_step)) then
	call range%expr_step%evaluate ()
	if (range%expr_step%is_known ()) then
	range%i_step = range%expr_step%get_int ()
	select case (range%step_mode)
	case (STEP_SUB); range%i_step = - range%i_step
	end select
	else
	call range%write ()
	call msg_fatal &
	("Range expression: step value evaluates to unknown")
	end if
	else
	range%i_step = 1
	end if
	else
	call range%write ()
	call msg_fatal &
	("Range expression: final value evaluates to unknown")
	end if
	else
	range%i_end = range%i_beg
	range%i_step = 1
	end if
	select case (range%step_mode)
	case (STEP_NONE)
	range%n_step = 1
	case (STEP_ADD, STEP_SUB)
	if (range%i_step /= 0) then
	if (range%i_beg == range%i_end) then
	range%n_step = 1
	else if (sign (1, range%i_end - range%i_beg) &
	== sign (1, range%i_step)) then
	range%n_step = (range%i_end - range%i_beg) / range%i_step + 1
	else
	range%n_step = 0
	end if
	else
	call msg_fatal ("range evaluation (add): step value is zero")
	end if
	case (STEP_MUL)
	if (range%i_step > 1) then
	if (range%i_beg == range%i_end) then
	range%n_step = 1
	else if (range%i_beg == 0) then
	call msg_fatal ("range evaluation (mul): initial value is zero")
	else if (sign (1, range%i_beg) == sign (1, range%i_end) &
	.and. abs (range%i_beg) < abs (range%i_end)) then
	range%n_step = 0
	ival = range%i_beg
	do while (abs (ival) <= abs (range%i_end))
	range%n_step = range%n_step + 1
	ival = ival * range%i_step
	end do
	else
	range%n_step = 0
	end if
	else
	call msg_fatal &
	("range evaluation (mult): step value is one or less")
	end if
	case (STEP_DIV)
	if (range%i_step > 1) then
	if (range%i_beg == range%i_end) then
	range%n_step = 1
	else if (sign (1, range%i_beg) == sign (1, range%i_end) &
	.and. abs (range%i_beg) > abs (range%i_end)) then
	range%n_step = 0
	ival = range%i_beg
	do while (abs (ival) >= abs (range%i_end))
	range%n_step = range%n_step + 1
	if (ival == 0) exit
	ival = ival / range%i_step
	end do
	else
	range%n_step = 0
	end if
	else
	call msg_fatal &
	("range evaluation (div): step value is one or less")
	end if
	case (STEP_COMP_ADD)
	call msg_fatal ("range evaluation: &
	&step mode /+/ not allowed for integer variable")
	case (STEP_COMP_MUL)
	call msg_fatal ("range evaluation: &
	&step mode /*/ not allowed for integer variable")
	case default
	call range%write ()
	call msg_bug ("range evaluation: step mode not implemented")
	end select
	end if
	end subroutine range_int_evaluate

	@ %def range_int_evaluate
	@ The version for a real variable.
	<<Commands: range real: TBP>>=
	procedure :: evaluate => range_real_evaluate
	<<Commands: sub interfaces>>=
	module subroutine range_real_evaluate (range)
	class(range_real_t), intent(inout) :: range
	end subroutine range_real_evaluate
	<<Commands: procedures>>=
	module subroutine range_real_evaluate (range)
	class(range_real_t), intent(inout) :: range
	if (associated (range%pn_beg)) then
	call range%expr_beg%evaluate ()
	if (range%expr_beg%is_known ()) then
	range%r_beg = range%expr_beg%get_real ()
	else
	call range%write ()
	call msg_fatal &
	("Range expression: initial value evaluates to unknown")
	end if
	if (associated (range%pn_end)) then
	call range%expr_end%evaluate ()
	if (range%expr_end%is_known ()) then
	range%r_end = range%expr_end%get_real ()
	if (associated (range%pn_step)) then
	if (range%expr_step%is_known ()) then
	select case (range%step_mode)
	case (STEP_ADD, STEP_SUB, STEP_MUL, STEP_DIV)
	call range%expr_step%evaluate ()
	range%r_step = range%expr_step%get_real ()
	select case (range%step_mode)
	case (STEP_SUB); range%r_step = - range%r_step
	end select
	case (STEP_COMP_ADD, STEP_COMP_MUL)
	range%n_step = &
	max (range%expr_step%get_int (), 0)
	end select
	else
	call range%write ()
	call msg_fatal &
	("Range expression: step value evaluates to unknown")
	end if
	else
	call range%write ()
	call msg_fatal &
	("Range expression (real): step value must be provided")
	end if
	else
	call range%write ()
	call msg_fatal &
	("Range expression: final value evaluates to unknown")
	end if
	else
	range%r_end = range%r_beg
	range%r_step = 1
	end if
	select case (range%step_mode)
	case (STEP_NONE)
	range%n_step = 1
	case (STEP_ADD, STEP_SUB)
	if (range%r_step /= 0) then
	if (sign (1._default, range%r_end - range%r_beg) &
	== sign (1._default, range%r_step)) then
	range%n_step = &
	nint ((range%r_end - range%r_beg) / range%r_step + 1)
	else
	range%n_step = 0
	end if
	else
	call msg_fatal ("range evaluation (add): step value is zero")
	end if
	case (STEP_MUL)
	if (range%r_step > 1) then
	if (range%r_beg == 0 .or. range%r_end == 0) then
	call msg_fatal ("range evaluation (mul): bound is zero")
	else if (sign (1._default, range%r_beg) &
	== sign (1._default, range%r_end) &
	.and. abs (range%r_beg) <= abs (range%r_end)) then
	range%lr_beg = log (abs (range%r_beg))
	range%lr_end = log (abs (range%r_end))
	range%lr_step = log (range%r_step)
	range%n_step = nint &
	(abs ((range%lr_end - range%lr_beg) / range%lr_step) + 1)
	else
	range%n_step = 0
	end if
	else
	call msg_fatal &
	("range evaluation (mult): step value is one or less")
	end if
	case (STEP_DIV)
	if (range%r_step > 1) then
	if (range%r_beg == 0 .or. range%r_end == 0) then
	call msg_fatal ("range evaluation (div): bound is zero")
	else if (sign (1._default, range%r_beg) &
	== sign (1._default, range%r_end) &
	.and. abs (range%r_beg) >= abs (range%r_end)) then
	range%lr_beg = log (abs (range%r_beg))
	range%lr_end = log (abs (range%r_end))
	range%lr_step = -log (range%r_step)
	range%n_step = nint &
	(abs ((range%lr_end - range%lr_beg) / range%lr_step) + 1)
	else
	range%n_step = 0
	end if
	else
	call msg_fatal &
	("range evaluation (mult): step value is one or less")
	end if
	case (STEP_COMP_ADD)
	! Number of steps already known
	case (STEP_COMP_MUL)
	! Number of steps already known
	if (range%r_beg == 0 .or. range%r_end == 0) then
	call msg_fatal ("range evaluation (mul): bound is zero")
	else if (sign (1._default, range%r_beg) &
	== sign (1._default, range%r_end)) then
	range%lr_beg = log (abs (range%r_beg))
	range%lr_end = log (abs (range%r_end))
	else
	range%n_step = 0
	end if
	case default
	call range%write ()
	call msg_bug ("range evaluation: step mode not implemented")
	end select
	end if
	end subroutine range_real_evaluate

	@ %def range_real_evaluate
	@ Return the number of iterations:
	<<Commands: range: TBP>>=
	procedure :: get_n_iterations => range_get_n_iterations
	<<Commands: sub interfaces>>=
	module function range_get_n_iterations (range) result (n)
	class(range_t), intent(in) :: range
	integer :: n
	end function range_get_n_iterations
	<<Commands: procedures>>=
	module function range_get_n_iterations (range) result (n)
	class(range_t), intent(in) :: range
	integer :: n
	n = range%n_step
	end function range_get_n_iterations

	@ %def range_get_n_iterations
	@ Compute the value for iteration [[i]] and store it in the embedded token.
	<<Commands: range: TBP>>=
	procedure (range_set_value), deferred :: set_value
	<<Commands: interfaces>>=
	abstract interface
	subroutine range_set_value (range, i)
	import
	class(range_t), intent(inout) :: range
	integer, intent(in) :: i
	end subroutine range_set_value
	end interface

	@ %def range_set_value
	@ In the integer case, we compute the value directly for additive step. For
	multiplicative step, we perform a loop in the same way as above, where the
	number of iteration was determined.
	<<Commands: range int: TBP>>=
	procedure :: set_value => range_int_set_value
	<<Commands: sub interfaces>>=
	module subroutine range_int_set_value (range, i)
	class(range_int_t), intent(inout) :: range
	integer, intent(in) :: i
	end subroutine range_int_set_value
	<<Commands: procedures>>=
	module subroutine range_int_set_value (range, i)
	class(range_int_t), intent(inout) :: range
	integer, intent(in) :: i
	integer :: k, ival
	select case (range%step_mode)
	case (STEP_NONE)
	ival = range%i_beg
	case (STEP_ADD, STEP_SUB)
	ival = range%i_beg + (i - 1) * range%i_step
	case (STEP_MUL)
	ival = range%i_beg
	do k = 1, i - 1
	ival = ival * range%i_step
	end do
	case (STEP_DIV)
	ival = range%i_beg
	do k = 1, i - 1
	ival = ival / range%i_step
	end do
	case default
	call range%write ()
	call msg_bug ("range iteration: step mode not implemented")
	end select
	call parse_node_set_value (range%pn_literal, ival = ival)
	end subroutine range_int_set_value

	@ %def range_int_set_value
	@ In the integer case, we compute the value directly for additive step. For
	multiplicative step, we perform a loop in the same way as above, where the
	number of iteration was determined.
	<<Commands: range real: TBP>>=
	procedure :: set_value => range_real_set_value
	<<Commands: sub interfaces>>=
	module subroutine range_real_set_value (range, i)
	class(range_real_t), intent(inout) :: range
	integer, intent(in) :: i
	end subroutine range_real_set_value
	<<Commands: procedures>>=
	module subroutine range_real_set_value (range, i)
	class(range_real_t), intent(inout) :: range
	integer, intent(in) :: i
	real(default) :: rval, x
	select case (range%step_mode)
	case (STEP_NONE)
	rval = range%r_beg
	case (STEP_ADD, STEP_SUB, STEP_COMP_ADD)
	if (range%n_step > 1) then
	x = real (i - 1, default) / (range%n_step - 1)
	else
	x = 1._default / 2
	end if
	rval = x * range%r_end + (1 - x) * range%r_beg
	case (STEP_MUL, STEP_DIV, STEP_COMP_MUL)
	if (range%n_step > 1) then
	x = real (i - 1, default) / (range%n_step - 1)
	else
	x = 1._default / 2
	end if
	rval = sign &
	(exp (x * range%lr_end + (1 - x) * range%lr_beg), range%r_beg)
	case default
	call range%write ()
	call msg_bug ("range iteration: step mode not implemented")
	end select
	call parse_node_set_value (range%pn_literal, rval = rval)
	end subroutine range_real_set_value

	@ %def range_real_set_value
	@
	\subsubsection{Scan over parameters and other objects}
	The scan command allocates a new parse node for the variable
	assignment (the lhs). The rhs of this parse node is assigned from the
	available rhs expressions in the scan list, one at a time, so the
	compiled parse node can be prepended to the scan body.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_scan_t
	private
	type(string_t) :: name
	integer :: n_values = 0
	type(parse_node_p), dimension(:), allocatable :: scan_cmd
	class(range_t), dimension(:), allocatable :: range
	contains
	<<Commands: cmd scan: TBP>>
	end type cmd_scan_t

	@ %def cmd_scan_t
	@ Finalizer.

	The auxiliary parse nodes that we have constructed have to be treated
	carefully: the embedded pointers all point to persistent objects
	somewhere else and should not be finalized, so we should not call the
	finalizer recursively.
	<<Commands: cmd scan: TBP>>=
	procedure :: final => cmd_scan_final
	<<Commands: sub interfaces>>=
	recursive module subroutine cmd_scan_final (cmd)
	class(cmd_scan_t), intent(inout) :: cmd
	end subroutine cmd_scan_final
	<<Commands: procedures>>=
	recursive module subroutine cmd_scan_final (cmd)
	class(cmd_scan_t), intent(inout) :: cmd
	type(parse_node_t), pointer :: pn_var_single, pn_decl_single
	type(string_t) :: key
	integer :: i
	if (allocated (cmd%scan_cmd)) then
	do i = 1, size (cmd%scan_cmd)
	pn_var_single => parse_node_get_sub_ptr (cmd%scan_cmd(i)%ptr)
	key = parse_node_get_rule_key (pn_var_single)
	select case (char (key))
	case ("scan_string_decl", "scan_log_decl")
	pn_decl_single => parse_node_get_sub_ptr (pn_var_single, 2)
	call parse_node_final (pn_decl_single, recursive=.false.)
	deallocate (pn_decl_single)
	end select
	call parse_node_final (pn_var_single, recursive=.false.)
	deallocate (pn_var_single)
	end do
	deallocate (cmd%scan_cmd)
	end if
	if (allocated (cmd%range)) then
	do i = 1, size (cmd%range)
	call cmd%range(i)%final ()
	end do
	end if
	end subroutine cmd_scan_final

	@ %def cmd_scan_final
	@ Output.
	<<Commands: cmd scan: TBP>>=
	procedure :: write => cmd_scan_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_scan_write (cmd, unit, indent)
	class(cmd_scan_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_scan_write
	<<Commands: procedures>>=
	module subroutine cmd_scan_write (cmd, unit, indent)
	class(cmd_scan_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,A,1x,'(',I0,')')") "scan:", char (cmd%name), &
	cmd%n_values
	end subroutine cmd_scan_write

	@ %def cmd_scan_write
	@ Compile the scan command. We construct a new parse node that
	implements the variable assignment for a single element on the rhs,
	instead of the whole list that we get from the original parse tree.
	By simply copying the node, we copy all pointers and inherit the
	targets from the original. During execution, we should replace the
	rhs by the stored rhs pointers (the list elements), one by one, then
	(re)compile the redefined node.
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<Commands: cmd scan: TBP>>=
	procedure :: compile => cmd_scan_compile
	<<Commands: main procedures>>=
	recursive subroutine cmd_scan_compile (cmd, global)
	class(cmd_scan_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(parse_node_t), pointer :: pn_var, pn_body, pn_body_first
	type(parse_node_t), pointer :: pn_decl, pn_name
	type(parse_node_t), pointer :: pn_arg, pn_scan_cmd, pn_rhs
	type(parse_node_t), pointer :: pn_decl_single, pn_var_single
	type(syntax_rule_t), pointer :: var_rule_decl, var_rule
	type(string_t) :: key
	integer :: var_type
	integer :: i
	if (debug_on) call msg_debug (D_CORE, "cmd_scan_compile")
	if (debug_active (D_CORE)) call parse_node_write_rec (cmd%pn)
	pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_body => parse_node_get_next_ptr (pn_var)
	if (associated (pn_body)) then
	pn_body_first => parse_node_get_sub_ptr (pn_body)
	else
	pn_body_first => null ()
	end if
	key = parse_node_get_rule_key (pn_var)
	select case (char (key))
	case ("scan_num")
	pn_name => parse_node_get_sub_ptr (pn_var)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_num"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_int")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_int"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_real")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_real"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_complex")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str("cmd_complex"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_alias")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_alias"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_string_decl")
	pn_decl => parse_node_get_sub_ptr (pn_var, 2)
	pn_name => parse_node_get_sub_ptr (pn_decl, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_string"))
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_string_decl"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_log_decl")
	pn_decl => parse_node_get_sub_ptr (pn_var, 2)
	pn_name => parse_node_get_sub_ptr (pn_decl, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_log"))
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_log_decl"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_cuts")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_cuts"))
	cmd%name = "cuts"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_weight")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_weight"))
	cmd%name = "weight"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_scale")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_scale"))
	cmd%name = "scale"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_ren_scale")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_ren_scale"))
	cmd%name = "renormalization_scale"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_fac_scale")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_fac_scale"))
	cmd%name = "factorization_scale"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_selection")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_selection"))
	cmd%name = "selection"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_reweight")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_reweight"))
	cmd%name = "reweight"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_analysis")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_analysis"))
	cmd%name = "analysis"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_model")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_model"))
	cmd%name = "model"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_library")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_library"))
	cmd%name = "library"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case default
	call msg_bug ("scan: case '" // char (key) // "' not implemented")
	end select
	if (associated (pn_arg)) then
	cmd%n_values = parse_node_get_n_sub (pn_arg)
	end if
	var_list => global%get_var_list_ptr ()
	allocate (cmd%scan_cmd (cmd%n_values))
	select case (char (key))
	case ("scan_num")
	var_type = &
	var_list%get_type (cmd%name)
	select case (var_type)
	case (V_INT)
	allocate (range_int_t :: cmd%range (cmd%n_values))
	case (V_REAL)
	allocate (range_real_t :: cmd%range (cmd%n_values))
	case (V_CMPLX)
	call msg_fatal ("scan over complex variable not implemented")
	case (V_NONE)
	call msg_fatal ("scan: variable '" // char (cmd%name) //"' undefined")
	case default
	call msg_bug ("scan: impossible variable type")
	end select
	case ("scan_int")
	allocate (range_int_t :: cmd%range (cmd%n_values))
	case ("scan_real")
	allocate (range_real_t :: cmd%range (cmd%n_values))
	case ("scan_complex")
	call msg_fatal ("scan over complex variable not implemented")
	end select
	i = 1
	if (associated (pn_arg)) then
	pn_rhs => parse_node_get_sub_ptr (pn_arg)
	else
	pn_rhs => null ()
	end if
	do while (associated (pn_rhs))
	allocate (pn_scan_cmd)
	call parse_node_create_branch (pn_scan_cmd, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("command_list")))
	allocate (pn_var_single)
	pn_var_single = pn_var
	call parse_node_replace_rule (pn_var_single, var_rule)
	select case (char (key))
	case ("scan_num", "scan_int", "scan_real", &
	"scan_complex", "scan_alias", &
	"scan_cuts", "scan_weight", &
	"scan_scale", "scan_ren_scale", "scan_fac_scale", &
	"scan_selection", "scan_reweight", "scan_analysis", &
	"scan_model", "scan_library")
	if (allocated (cmd%range)) then
	call cmd%range(i)%init (pn_rhs)
	call parse_node_replace_last_sub &
	(pn_var_single, cmd%range(i)%pn_expr)
	else
	call parse_node_replace_last_sub (pn_var_single, pn_rhs)
	end if
	case ("scan_string_decl", "scan_log_decl")
	allocate (pn_decl_single)
	pn_decl_single = pn_decl
	call parse_node_replace_rule (pn_decl_single, var_rule_decl)
	call parse_node_replace_last_sub (pn_decl_single, pn_rhs)
	call parse_node_freeze_branch (pn_decl_single)
	call parse_node_replace_last_sub (pn_var_single, pn_decl_single)
	case default
	call msg_bug ("scan: case '" // char (key) &
	// "' broken")
	end select
	call parse_node_freeze_branch (pn_var_single)
	call parse_node_append_sub (pn_scan_cmd, pn_var_single)
	call parse_node_append_sub (pn_scan_cmd, pn_body_first)
	call parse_node_freeze_branch (pn_scan_cmd)
	cmd%scan_cmd(i)%ptr => pn_scan_cmd
	i = i + 1
	pn_rhs => parse_node_get_next_ptr (pn_rhs)
	end do
	if (debug_active (D_CORE)) then
	do i = 1, cmd%n_values
	print *, "scan command ", i
	call parse_node_write_rec (cmd%scan_cmd(i)%ptr)
	if (allocated (cmd%range)) call cmd%range(i)%write ()
	end do
	print *, "original"
	call parse_node_write_rec (cmd%pn)
	end if
	end subroutine cmd_scan_compile

	@ %def cmd_scan_compile
	@ Execute the loop for all values in the step list. We use the
	parse trees with single variable assignment that we have stored, to
	iteratively create a local environment, execute the stored commands, and
	destroy it again. When we encounter a range object, we execute the commands
	for each value that this object provides. Computing this value has the side
	effect of modifying the rhs of the variable assignment that heads the local
	command list, directly in the local parse tree.
	<<Commands: cmd scan: TBP>>=
	procedure :: execute => cmd_scan_execute
	<<Commands: sub interfaces>>=
	recursive module subroutine cmd_scan_execute (cmd, global)
	class(cmd_scan_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_scan_execute
	<<Commands: procedures>>=
	recursive module subroutine cmd_scan_execute (cmd, global)
	class(cmd_scan_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(rt_data_t), allocatable :: local
	integer :: i, j
	do i = 1, cmd%n_values
	if (allocated (cmd%range)) then
	call cmd%range(i)%compile (global)
	call cmd%range(i)%evaluate ()
	do j = 1, cmd%range(i)%get_n_iterations ()
	call cmd%range(i)%set_value (j)
	allocate (local)
	call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
	call local%local_final ()
	deallocate (local)
	end do
	else
	allocate (local)
	call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
	call local%local_final ()
	deallocate (local)
	end if
	end do
	end subroutine cmd_scan_execute

	@ %def cmd_scan_execute
	@
	\subsubsection{Conditionals}
	Conditionals are implemented as a list that is compiled and evaluated
	recursively; this allows for a straightforward representation of
	[[else if]] constructs. A [[cmd_if_t]] object can hold either an
	[[else_if]] clause which is another object of this type, or an
	[[else_body]], but not both.

	If- or else-bodies are no scoping units, so all data remain global and
	no copy-in copy-out is needed.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_if_t
	private
	type(parse_node_t), pointer :: pn_if_lexpr => null ()
	type(command_list_t), pointer :: if_body => null ()
	type(cmd_if_t), dimension(:), pointer :: elsif_cmd => null ()
	type(command_list_t), pointer :: else_body => null ()
	contains
	<<Commands: cmd if: TBP>>
	end type cmd_if_t

	@ %def cmd_if_t
	@ Finalizer. There are no local options, therefore we can simply override
	the default finalizer.
	<<Commands: cmd if: TBP>>=
	procedure :: final => cmd_if_final
	<<Commands: sub interfaces>>=
	recursive module subroutine cmd_if_final (cmd)
	class(cmd_if_t), intent(inout) :: cmd
	end subroutine cmd_if_final
	<<Commands: procedures>>=
	recursive module subroutine cmd_if_final (cmd)
	class(cmd_if_t), intent(inout) :: cmd
	integer :: i
	if (associated (cmd%if_body)) then
	call command_list_final (cmd%if_body)
	deallocate (cmd%if_body)
	end if
	if (associated (cmd%elsif_cmd)) then
	do i = 1, size (cmd%elsif_cmd)
	call cmd_if_final (cmd%elsif_cmd(i))
	end do
	deallocate (cmd%elsif_cmd)
	end if
	if (associated (cmd%else_body)) then
	call command_list_final (cmd%else_body)
	deallocate (cmd%else_body)
	end if
	end subroutine cmd_if_final

	@ %def cmd_if_final
	@ Output. Recursively write the command lists.
	<<Commands: cmd if: TBP>>=
	procedure :: write => cmd_if_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_if_write (cmd, unit, indent)
	class(cmd_if_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_if_write
	<<Commands: procedures>>=
	module subroutine cmd_if_write (cmd, unit, indent)
	class(cmd_if_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, ind, i
	u = given_output_unit (unit); if (u < 0) return
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, indent)
	write (u, "(A)") "if <expr> then"
	if (associated (cmd%if_body)) then
	call cmd%if_body%write (unit, ind + 1)
	end if
	if (associated (cmd%elsif_cmd)) then
	do i = 1, size (cmd%elsif_cmd)
	call write_indent (u, indent)
	write (u, "(A)") "elsif <expr> then"
	if (associated (cmd%elsif_cmd(i)%if_body)) then
	call cmd%elsif_cmd(i)%if_body%write (unit, ind + 1)
	end if
	end do
	end if
	if (associated (cmd%else_body)) then
	call write_indent (u, indent)
	write (u, "(A)") "else"
	call cmd%else_body%write (unit, ind + 1)
	end if
	end subroutine cmd_if_write

	@ %def cmd_if_write
	@ Compile the conditional.
	<<Commands: cmd if: TBP>>=
	procedure :: compile => cmd_if_compile
	<<Commands: sub interfaces>>=
	recursive module subroutine cmd_if_compile (cmd, global)
	class(cmd_if_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_if_compile
	<<Commands: procedures>>=
	recursive module subroutine cmd_if_compile (cmd, global)
	class(cmd_if_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_lexpr, pn_body
	type(parse_node_t), pointer :: pn_elsif_clauses, pn_cmd_elsif
	type(parse_node_t), pointer :: pn_else_clause, pn_cmd_else
	integer :: i, n_elsif
	pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_if_lexpr => pn_lexpr
	pn_body => parse_node_get_next_ptr (pn_lexpr, 2)
	select case (char (parse_node_get_rule_key (pn_body)))
	case ("command_list")
	allocate (cmd%if_body)
	call cmd%if_body%compile (pn_body, global)
	pn_elsif_clauses => parse_node_get_next_ptr (pn_body)
	case default
	pn_elsif_clauses => pn_body
	end select
	select case (char (parse_node_get_rule_key (pn_elsif_clauses)))
	case ("elsif_clauses")
	n_elsif = parse_node_get_n_sub (pn_elsif_clauses)
	allocate (cmd%elsif_cmd (n_elsif))
	pn_cmd_elsif => parse_node_get_sub_ptr (pn_elsif_clauses)
	do i = 1, n_elsif
	pn_lexpr => parse_node_get_sub_ptr (pn_cmd_elsif, 2)
	cmd%elsif_cmd(i)%pn_if_lexpr => pn_lexpr
	pn_body => parse_node_get_next_ptr (pn_lexpr, 2)
	if (associated (pn_body)) then
	allocate (cmd%elsif_cmd(i)%if_body)
	call cmd%elsif_cmd(i)%if_body%compile (pn_body, global)
	end if
	pn_cmd_elsif => parse_node_get_next_ptr (pn_cmd_elsif)
	end do
	pn_else_clause => parse_node_get_next_ptr (pn_elsif_clauses)
	case default
	pn_else_clause => pn_elsif_clauses
	end select
	select case (char (parse_node_get_rule_key (pn_else_clause)))
	case ("else_clause")
	pn_cmd_else => parse_node_get_sub_ptr (pn_else_clause)
	pn_body => parse_node_get_sub_ptr (pn_cmd_else, 2)
	if (associated (pn_body)) then
	allocate (cmd%else_body)
	call cmd%else_body%compile (pn_body, global)
	end if
	end select
	end subroutine cmd_if_compile

	@ %def global
	@ (Recursively) execute the condition. Context remains global in all cases.
	<<Commands: cmd if: TBP>>=
	procedure :: execute => cmd_if_execute
	<<Commands: sub interfaces>>=
	recursive module subroutine cmd_if_execute (cmd, global)
	class(cmd_if_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_if_execute
	<<Commands: procedures>>=
	recursive module subroutine cmd_if_execute (cmd, global)
	class(cmd_if_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	logical :: lval, is_known
	integer :: i
	var_list => global%get_var_list_ptr ()
	lval = eval_log (cmd%pn_if_lexpr, var_list, is_known=is_known)
	if (is_known) then
	if (lval) then
	if (associated (cmd%if_body)) then
	call cmd%if_body%execute (global)
	end if
	return
	end if
	else
	call error_undecided ()
	return
	end if
	if (associated (cmd%elsif_cmd)) then
	SCAN_ELSIF: do i = 1, size (cmd%elsif_cmd)
	lval = eval_log (cmd%elsif_cmd(i)%pn_if_lexpr, var_list, &
	is_known=is_known)
	if (is_known) then
	if (lval) then
	if (associated (cmd%elsif_cmd(i)%if_body)) then
	call cmd%elsif_cmd(i)%if_body%execute (global)
	end if
	return
	end if
	else
	call error_undecided ()
	return
	end if
	end do SCAN_ELSIF
	end if
	if (associated (cmd%else_body)) then
	call cmd%else_body%execute (global)
	end if
	contains
	subroutine error_undecided ()
	call msg_error ("Undefined result of conditional expression: " &
	// "neither branch will be executed")
	end subroutine error_undecided
	end subroutine cmd_if_execute

	@ %def cmd_if_execute
	@
	\subsubsection{Include another command-list file}
	The include command allocates a local parse tree. This must not be
	deleted before the command object itself is deleted, since pointers
	may point to subobjects of it.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_include_t
	private
	type(string_t) :: file
	type(command_list_t), pointer :: command_list => null ()
	type(parse_tree_t) :: parse_tree
	contains
	<<Commands: cmd include: TBP>>
	end type cmd_include_t

	@ %def cmd_include_t
	@ Finalizer: delete the command list. No options, so we can simply override
	the default finalizer.
	<<Commands: cmd include: TBP>>=
	procedure :: final => cmd_include_final
	<<Commands: sub interfaces>>=
	module subroutine cmd_include_final (cmd)
	class(cmd_include_t), intent(inout) :: cmd
	end subroutine cmd_include_final
	<<Commands: procedures>>=
	module subroutine cmd_include_final (cmd)
	class(cmd_include_t), intent(inout) :: cmd
	call parse_tree_final (cmd%parse_tree)
	if (associated (cmd%command_list)) then
	call cmd%command_list%final ()
	deallocate (cmd%command_list)
	end if
	end subroutine cmd_include_final

	@ %def cmd_include_final
	@ Write: display the command list as-is, if allocated.
	<<Commands: cmd include: TBP>>=
	procedure :: write => cmd_include_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_include_write (cmd, unit, indent)
	class(cmd_include_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_include_write
	<<Commands: procedures>>=
	module subroutine cmd_include_write (cmd, unit, indent)
	class(cmd_include_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, indent)
	write (u, "(A,A,A,A)") "include ", '"', char (cmd%file), '"'
	if (associated (cmd%command_list)) then
	call cmd%command_list%write (u, ind + 1)
	end if
	end subroutine cmd_include_write

	@ %def cmd_include_write
	@ Compile file contents: First parse the file, then immediately
	compile its contents. Use the global data set.
	<<Commands: cmd include: TBP>>=
	procedure :: compile => cmd_include_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_include_compile (cmd, global)
	class(cmd_include_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_include_compile
	<<Commands: procedures>>=
	module subroutine cmd_include_compile (cmd, global)
	class(cmd_include_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_file
	type(string_t) :: file
	logical :: exist
	integer :: u
	type(stream_t), target :: stream
	type(lexer_t) :: lexer
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_file => parse_node_get_sub_ptr (pn_arg)
	file = parse_node_get_string (pn_file)
	inquire (file=char(file), exist=exist)
	if (exist) then
	cmd%file = file
	else
	cmd%file = global%os_data%whizard_cutspath // "/" // file
	inquire (file=char(cmd%file), exist=exist)
	if (.not. exist) then
	call msg_error ("Include file '" // char (file) // "' not found")
	return
	end if
	end if
	u = free_unit ()
	call lexer_init_cmd_list (lexer, global%lexer)
	call stream_init (stream, char (cmd%file))
	call lexer_assign_stream (lexer, stream)
	call parse_tree_init (cmd%parse_tree, syntax_cmd_list, lexer)
	call stream_final (stream)
	call lexer_final (lexer)
	close (u)
	allocate (cmd%command_list)
	call cmd%command_list%compile (cmd%parse_tree%get_root_ptr (), &
	global)
	end subroutine cmd_include_compile

	@ %def cmd_include_compile
	@ Execute file contents in the global context.
	<<Commands: cmd include: TBP>>=
	procedure :: execute => cmd_include_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_include_execute (cmd, global)
	class(cmd_include_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_include_execute
	<<Commands: procedures>>=
	module subroutine cmd_include_execute (cmd, global)
	class(cmd_include_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (associated (cmd%command_list)) then
	call msg_message &
	("Including Sindarin from '" // char (cmd%file) // "'")
	call cmd%command_list%execute (global)
	call msg_message &
	("End of included '" // char (cmd%file) // "'")
	end if
	end subroutine cmd_include_execute

	@ %def cmd_include_execute
	@
	\subsubsection{Export values}
	This command exports the current values of variables or other objects to the
	surrounding scope. By default, a scope enclosed by braces keeps all objects
	local to it. The [[export]] command exports the values that are generated
	within the scope to the corresponding object in the outer scope.

	The allowed set of exportable objects is, in principle, the same as the set of
	objects that the [[show]] command supports. This includes some convenience
	abbreviations.

	TODO: The initial implementation inherits syntax from [[show]], but supports
	only the [[results]] pseudo-object. The results (i.e., the process stack) is
	appended to the outer process stack instead of being discarded. The behavior
	of the [[export]] command for other object kinds is to be defined on a
	case-by-case basis. It may involve replacing the outer value or, instead,
	doing some sort of appending or reduction.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_export_t
	private
	type(string_t), dimension(:), allocatable :: name
	contains
	<<Commands: cmd export: TBP>>
	end type cmd_export_t

	@ %def cmd_export_t
	@ Output: list the object names, not values.
	<<Commands: cmd export: TBP>>=
	procedure :: write => cmd_export_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_export_write (cmd, unit, indent)
	class(cmd_export_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_export_write
	<<Commands: procedures>>=
	module subroutine cmd_export_write (cmd, unit, indent)
	class(cmd_export_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "export: "
	if (allocated (cmd%name)) then
	do i = 1, size (cmd%name)
	write (u, "(1x,A)", advance="no") char (cmd%name(i))
	end do
	write (u, *)
	else
	write (u, "(5x,A)") "[undefined]"
	end if
	end subroutine cmd_export_write

	@ %def cmd_export_write
	@ Compile. Allocate an array which is filled with the names of the
	variables to export.
	<<Commands: cmd export: TBP>>=
	procedure :: compile => cmd_export_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_export_compile (cmd, global)
	class(cmd_export_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_export_compile
	<<Commands: procedures>>=
	module subroutine cmd_export_compile (cmd, global)
	class(cmd_export_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
	type(string_t) :: key
	integer :: i, n_args
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (pn_arg)) then
	select case (char (parse_node_get_rule_key (pn_arg)))
	case ("show_arg")
	cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
	case default
	cmd%pn_opt => pn_arg
	pn_arg => null ()
	end select
	end if
	call cmd%compile_options (global)
	if (associated (pn_arg)) then
	n_args = parse_node_get_n_sub (pn_arg)
	allocate (cmd%name (n_args))
	pn_var => parse_node_get_sub_ptr (pn_arg)
	i = 0
	do while (associated (pn_var))
	i = i + 1
	select case (char (parse_node_get_rule_key (pn_var)))
	case ("model", "library", "beams", "iterations", &
	"cuts", "weight", "int", "real", "complex", &
	"scale", "factorization_scale", "renormalization_scale", &
	"selection", "reweight", "analysis", "pdg", &
	"stable", "unstable", "polarized", "unpolarized", &
	"results", "expect", "intrinsic", "string", "logical")
	cmd%name(i) = parse_node_get_key (pn_var)
	case ("result_var")
	pn_prefix => parse_node_get_sub_ptr (pn_var)
	pn_name => parse_node_get_next_ptr (pn_prefix)
	if (associated (pn_name)) then
	cmd%name(i) = parse_node_get_key (pn_prefix) &
	// "(" // parse_node_get_string (pn_name) // ")"
	else
	cmd%name(i) = parse_node_get_key (pn_prefix)
	end if
	case ("log_var", "string_var", "alias_var")
	pn_prefix => parse_node_get_sub_ptr (pn_var)
	pn_name => parse_node_get_next_ptr (pn_prefix)
	key = parse_node_get_key (pn_prefix)
	if (associated (pn_name)) then
	select case (char (parse_node_get_rule_key (pn_name)))
	case ("var_name")
	select case (char (key))
	case ("?", "$") ! $ sign
	cmd%name(i) = key // parse_node_get_string (pn_name)
	case ("alias")
	cmd%name(i) = parse_node_get_string (pn_name)
	end select
	case default
	call parse_node_mismatch &
	("var_name", pn_name)
	end select
	else
	cmd%name(i) = key
	end if
	case default
	cmd%name(i) = parse_node_get_string (pn_var)
	end select
	!!! restriction imposed by current lack of implementation
	select case (char (parse_node_get_rule_key (pn_var)))
	case ("results")
	case default
	call msg_fatal ("export: object (type) '" &
	// char (parse_node_get_rule_key (pn_var)) &
	// "' not supported yet")
	end select
	pn_var => parse_node_get_next_ptr (pn_var)
	end do
	else
	allocate (cmd%name (0))
	end if
	end subroutine cmd_export_compile

	@ %def cmd_export_compile
	@ Execute. Scan the list of objects to export.
	<<Commands: cmd export: TBP>>=
	procedure :: execute => cmd_export_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_export_execute (cmd, global)
	class(cmd_export_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_export_execute
	<<Commands: procedures>>=
	module subroutine cmd_export_execute (cmd, global)
	class(cmd_export_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	call global%append_exports (cmd%name)
	end subroutine cmd_export_execute

	@ %def cmd_export_execute
	@
	\subsubsection{Quit command execution}
	The code is the return code of the whole program if it is terminated
	by this command.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_quit_t
	private
	logical :: has_code = .false.
	type(parse_node_t), pointer :: pn_code_expr => null ()
	contains
	<<Commands: cmd quit: TBP>>
	end type cmd_quit_t

	@ %def cmd_quit_t
	@ Output.
	<<Commands: cmd quit: TBP>>=
	procedure :: write => cmd_quit_write
	<<Commands: sub interfaces>>=
	module subroutine cmd_quit_write (cmd, unit, indent)
	class(cmd_quit_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_quit_write
	<<Commands: procedures>>=
	module subroutine cmd_quit_write (cmd, unit, indent)
	class(cmd_quit_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,L1)") "quit: has_code = ", cmd%has_code
	end subroutine cmd_quit_write

	@ %def cmd_quit_write
	@ Compile: allocate a [[quit]] object which serves as a placeholder.
	<<Commands: cmd quit: TBP>>=
	procedure :: compile => cmd_quit_compile
	<<Commands: sub interfaces>>=
	module subroutine cmd_quit_compile (cmd, global)
	class(cmd_quit_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_quit_compile
	<<Commands: procedures>>=
	module subroutine cmd_quit_compile (cmd, global)
	class(cmd_quit_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (pn_arg)) then
	cmd%pn_code_expr => parse_node_get_sub_ptr (pn_arg)
	cmd%has_code = .true.
	end if
	end subroutine cmd_quit_compile

	@ %def cmd_quit_compile
	@ Execute: The quit command does not execute anything, it just stops
	command execution. This is achieved by setting quit flag and quit
	code in the global variable list. However, the return code, if
	present, is an expression which has to be evaluated.
	<<Commands: cmd quit: TBP>>=
	procedure :: execute => cmd_quit_execute
	<<Commands: sub interfaces>>=
	module subroutine cmd_quit_execute (cmd, global)
	class(cmd_quit_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine cmd_quit_execute
	<<Commands: procedures>>=
	module subroutine cmd_quit_execute (cmd, global)
	class(cmd_quit_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	logical :: is_known
	var_list => global%get_var_list_ptr ()
	if (cmd%has_code) then
	global%quit_code = eval_int (cmd%pn_code_expr, var_list, &
	is_known=is_known)
	if (.not. is_known) then
	call msg_error ("Undefined return code of quit/exit command")
	end if
	end if
	global%quit = .true.
	end subroutine cmd_quit_execute

	@ %def cmd_quit_execute
	@
	\subsection{The command list}
	The command list holds a list of commands and relevant global data.
	<<Commands: public>>=
	public :: command_list_t
	<<Commands: types>>=
	type :: command_list_t
	! not private anymore as required by the whizard-c-interface
	class(command_t), pointer :: first => null ()
	class(command_t), pointer :: last => null ()
	contains
	<<Commands: command list: TBP>>
	end type command_list_t

	@ %def command_list_t
	@ Output.
	<<Commands: command list: TBP>>=
	procedure :: write => command_list_write
	<<Commands: sub interfaces>>=
	recursive module subroutine command_list_write (cmd_list, unit, indent)
	class(command_list_t), intent(in) :: cmd_list
	integer, intent(in), optional :: unit, indent
	end subroutine command_list_write
	<<Commands: procedures>>=
	recursive module subroutine command_list_write (cmd_list, unit, indent)
	class(command_list_t), intent(in) :: cmd_list
	integer, intent(in), optional :: unit, indent
	class(command_t), pointer :: cmd
	cmd => cmd_list%first
	do while (associated (cmd))
	call cmd%write (unit, indent)
	cmd => cmd%next
	end do
	end subroutine command_list_write

	@ %def command_list_write
	@ Append a new command to the list and free the original pointer.
	<<Commands: command list: TBP>>=
	procedure :: append => command_list_append
	<<Commands: sub interfaces>>=
	module subroutine command_list_append (cmd_list, command)
	class(command_list_t), intent(inout) :: cmd_list
	class(command_t), intent(inout), pointer :: command
	end subroutine command_list_append
	<<Commands: procedures>>=
	module subroutine command_list_append (cmd_list, command)
	class(command_list_t), intent(inout) :: cmd_list
	class(command_t), intent(inout), pointer :: command
	if (associated (cmd_list%last)) then
	cmd_list%last%next => command
	else
	cmd_list%first => command
	end if
	cmd_list%last => command
	command => null ()
	end subroutine command_list_append

	@ %def command_list_append
	@ Finalize.
	<<Commands: command list: TBP>>=
	procedure :: final => command_list_final
	<<Commands: sub interfaces>>=
	recursive module subroutine command_list_final (cmd_list)
	class(command_list_t), intent(inout) :: cmd_list
	end subroutine command_list_final
	<<Commands: procedures>>=
	recursive module subroutine command_list_final (cmd_list)
	class(command_list_t), intent(inout) :: cmd_list
	class(command_t), pointer :: command
	do while (associated (cmd_list%first))
	command => cmd_list%first
	cmd_list%first => cmd_list%first%next
	call command%final ()
	deallocate (command)
	end do
	cmd_list%last => null ()
	end subroutine command_list_final

	@ %def command_list_final
	@
	\subsection{Compiling the parse tree}
	Transform a parse tree into a command list. Initialization is assumed
	to be done.

	After each command, we set a breakpoint.
	Gfortran 7/8/9 bug: has to remain in the main module:
	<<Commands: command list: TBP>>=
	procedure :: compile => command_list_compile
	<<Commands: main procedures>>=
	recursive subroutine command_list_compile (cmd_list, pn, global)
	class(command_list_t), intent(inout), target :: cmd_list
	type(parse_node_t), intent(in), target :: pn
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_cmd
	class(command_t), pointer :: command
	integer :: i
	pn_cmd => parse_node_get_sub_ptr (pn)
	do i = 1, parse_node_get_n_sub (pn)
	call dispatch_command (command, pn_cmd)
	call command%compile (global)
	call cmd_list%append (command)
	call terminate_now_if_signal ()
	pn_cmd => parse_node_get_next_ptr (pn_cmd)
	end do
	end subroutine command_list_compile

	@ %def command_list_compile
	@
	\subsection{Executing the command list}
	Before executing a command we should execute its options (if any). After
	that, reset the options, i.e., remove temporary effects from the global
	state.

	Also here, after each command we set a breakpoint.
	<<Commands: command list: TBP>>=
	procedure :: execute => command_list_execute
	<<Commands: sub interfaces>>=
	recursive module subroutine command_list_execute (cmd_list, global)
	class(command_list_t), intent(in) :: cmd_list
	type(rt_data_t), intent(inout), target :: global
	end subroutine command_list_execute
	<<Commands: procedures>>=
	recursive module subroutine command_list_execute (cmd_list, global)
	class(command_list_t), intent(in) :: cmd_list
	type(rt_data_t), intent(inout), target :: global
	class(command_t), pointer :: command
	command => cmd_list%first
	COMMAND_COND: do while (associated (command))
	call command%execute_options (global)
	call command%execute (global)
	call command%reset_options (global)
	call terminate_now_if_signal ()
	if (global%quit) exit COMMAND_COND
	command => command%next
	end do COMMAND_COND
	end subroutine command_list_execute

	@ %def command_list_execute
	@
	\subsection{Command list syntax}
	<<Commands: public>>=
	public :: syntax_cmd_list
	<<Commands: variables>>=
	type(syntax_t), target, save :: syntax_cmd_list

	@ %def syntax_cmd_list
	<<Commands: public>>=
	public :: syntax_cmd_list_init
	<<Commands: sub interfaces>>=
	module subroutine syntax_cmd_list_init ()
	end subroutine syntax_cmd_list_init
	<<Commands: procedures>>=
	module subroutine syntax_cmd_list_init ()
	type(ifile_t) :: ifile
	call define_cmd_list_syntax (ifile)
	call syntax_init (syntax_cmd_list, ifile)
	call ifile_final (ifile)
	end subroutine syntax_cmd_list_init

	@ %def syntax_cmd_list_init
	<<Commands: public>>=
	public :: syntax_cmd_list_final
	<<Commands: sub interfaces>>=
	module subroutine syntax_cmd_list_final ()
	end subroutine syntax_cmd_list_final
	<<Commands: procedures>>=
	module subroutine syntax_cmd_list_final ()
	call syntax_final (syntax_cmd_list)
	end subroutine syntax_cmd_list_final

	@ %def syntax_cmd_list_final
	<<Commands: public>>=
	public :: syntax_cmd_list_write
	<<Commands: sub interfaces>>=
	module subroutine syntax_cmd_list_write (unit)
	integer, intent(in), optional :: unit
	end subroutine syntax_cmd_list_write
	<<Commands: procedures>>=
	module subroutine syntax_cmd_list_write (unit)
	integer, intent(in), optional :: unit
	call syntax_write (syntax_cmd_list, unit)
	end subroutine syntax_cmd_list_write

	@ %def syntax_cmd_list_write
	<<Commands: procedures>>=
	subroutine define_cmd_list_syntax (ifile)
	type(ifile_t), intent(inout) :: ifile
	call ifile_append (ifile, "SEQ command_list = command*")
	call ifile_append (ifile, "ALT command = " &
	// "cmd_model \| cmd_library \| cmd_iterations \| cmd_sample_format \| " &
	// "cmd_var \| cmd_slha \| " &
	// "cmd_show \| cmd_clear \| " &
	// "cmd_expect \| " &
	// "cmd_cuts \| cmd_scale \| cmd_fac_scale \| cmd_ren_scale \| " &
	// "cmd_weight \| cmd_selection \| cmd_reweight \| " &
	// "cmd_beams \| cmd_beams_pol_density \| cmd_beams_pol_fraction \| " &
	// "cmd_beams_momentum \| cmd_beams_theta \| cmd_beams_phi \| " &
	// "cmd_integrate \| " &
	// "cmd_observable \| cmd_histogram \| cmd_plot \| cmd_graph \| " &
	// "cmd_record \| " &
	// "cmd_analysis \| cmd_alt_setup \| " &
	// "cmd_unstable \| cmd_stable \| cmd_simulate \| cmd_rescan \| " &
	// "cmd_process \| cmd_compile \| cmd_exec \| " &
	// "cmd_scan \| cmd_if \| cmd_include \| cmd_quit \| " &
	// "cmd_export \| " &
	// "cmd_polarized \| cmd_unpolarized \| " &
	// "cmd_open_out \| cmd_close_out \| cmd_printf \| " &
	// "cmd_write_analysis \| cmd_compile_analysis \| cmd_nlo \| cmd_components")
	call ifile_append (ifile, "GRO options = '{' local_command_list '}'")
	call ifile_append (ifile, "SEQ local_command_list = local_command*")
	call ifile_append (ifile, "ALT local_command = " &
	// "cmd_model \| cmd_library \| cmd_iterations \| cmd_sample_format \| " &
	// "cmd_var \| cmd_slha \| " &
	// "cmd_show \| " &
	// "cmd_expect \| " &
	// "cmd_cuts \| cmd_scale \| cmd_fac_scale \| cmd_ren_scale \| " &
	// "cmd_weight \| cmd_selection \| cmd_reweight \| " &
	// "cmd_beams \| cmd_beams_pol_density \| cmd_beams_pol_fraction \| " &
	// "cmd_beams_momentum \| cmd_beams_theta \| cmd_beams_phi \| " &
	// "cmd_observable \| cmd_histogram \| cmd_plot \| cmd_graph \| " &
	// "cmd_clear \| cmd_record \| " &
	// "cmd_analysis \| cmd_alt_setup \| " &
	// "cmd_open_out \| cmd_close_out \| cmd_printf \| " &
	// "cmd_write_analysis \| cmd_compile_analysis \| cmd_nlo \| cmd_components")
	call ifile_append (ifile, "SEQ cmd_model = model '=' model_name model_arg?")
	call ifile_append (ifile, "KEY model")
	call ifile_append (ifile, "ALT model_name = model_id \| string_literal")
	call ifile_append (ifile, "IDE model_id")
	call ifile_append (ifile, "ARG model_arg = ( model_scheme? )")
	call ifile_append (ifile, "ALT model_scheme = " &
	// "ufo_spec \| scheme_id \| string_literal")
	call ifile_append (ifile, "SEQ ufo_spec = ufo ufo_arg?")
	call ifile_append (ifile, "KEY ufo")
	call ifile_append (ifile, "ARG ufo_arg = ( string_literal )")
	call ifile_append (ifile, "IDE scheme_id")
	call ifile_append (ifile, "SEQ cmd_library = library '=' lib_name")
	call ifile_append (ifile, "KEY library")
	call ifile_append (ifile, "ALT lib_name = lib_id \| string_literal")
	call ifile_append (ifile, "IDE lib_id")
	call ifile_append (ifile, "ALT cmd_var = " &
	// "cmd_log_decl \| cmd_log \| " &
	// "cmd_int \| cmd_real \| cmd_complex \| cmd_num \| " &
	// "cmd_string_decl \| cmd_string \| cmd_alias \| " &
	// "cmd_result")
	call ifile_append (ifile, "SEQ cmd_log_decl = logical cmd_log")
	call ifile_append (ifile, "SEQ cmd_log = '?' var_name '=' lexpr")
	call ifile_append (ifile, "SEQ cmd_int = int var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_real = real var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_complex = complex var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_num = var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_string_decl = string cmd_string")
	call ifile_append (ifile, "SEQ cmd_string = " &
	// "'$' var_name '=' sexpr") ! $
	call ifile_append (ifile, "SEQ cmd_alias = alias var_name '=' cexpr")
	call ifile_append (ifile, "SEQ cmd_result = result '=' expr")
	call ifile_append (ifile, "SEQ cmd_slha = slha_action slha_arg options?")
	call ifile_append (ifile, "ALT slha_action = " &
	// "read_slha \| write_slha")
	call ifile_append (ifile, "KEY read_slha")
	call ifile_append (ifile, "KEY write_slha")
	call ifile_append (ifile, "ARG slha_arg = ( string_literal )")
	call ifile_append (ifile, "SEQ cmd_show = show show_arg options?")
	call ifile_append (ifile, "KEY show")
	call ifile_append (ifile, "ARG show_arg = ( showable* )")
	call ifile_append (ifile, "ALT showable = " &
	// "model \| library \| beams \| iterations \| " &
	// "cuts \| weight \| logical \| string \| pdg \| " &
	// "scale \| factorization_scale \| renormalization_scale \| " &
	// "selection \| reweight \| analysis \| " &
	// "stable \| unstable \| polarized \| unpolarized \| " &
	// "expect \| intrinsic \| int \| real \| complex \| " &
	// "alias_var \| string \| results \| result_var \| " &
	// "log_var \| string_var \| var_name")
	call ifile_append (ifile, "KEY results")
	call ifile_append (ifile, "KEY intrinsic")
	call ifile_append (ifile, "SEQ alias_var = alias var_name")
	call ifile_append (ifile, "SEQ result_var = result_key result_arg?")
	call ifile_append (ifile, "SEQ log_var = '?' var_name")
	call ifile_append (ifile, "SEQ string_var = '$' var_name") ! $
	call ifile_append (ifile, "SEQ cmd_clear = clear clear_arg options?")
	call ifile_append (ifile, "KEY clear")
	call ifile_append (ifile, "ARG clear_arg = ( clearable* )")
	call ifile_append (ifile, "ALT clearable = " &
	// "beams \| iterations \| " &
	// "cuts \| weight \| " &
	// "scale \| factorization_scale \| renormalization_scale \| " &
	// "selection \| reweight \| analysis \| " &
	// "unstable \| polarized \| " &
	// "expect \| " &
	// "log_var \| string_var \| var_name")
	call ifile_append (ifile, "SEQ cmd_expect = expect expect_arg options?")
	call ifile_append (ifile, "KEY expect")
	call ifile_append (ifile, "ARG expect_arg = ( lexpr )")
	call ifile_append (ifile, "SEQ cmd_cuts = cuts '=' lexpr")
	call ifile_append (ifile, "SEQ cmd_scale = scale '=' expr")
	call ifile_append (ifile, "SEQ cmd_fac_scale = " &
	// "factorization_scale '=' expr")
	call ifile_append (ifile, "SEQ cmd_ren_scale = " &
	// "renormalization_scale '=' expr")
	call ifile_append (ifile, "SEQ cmd_weight = weight '=' expr")
	call ifile_append (ifile, "SEQ cmd_selection = selection '=' lexpr")
	call ifile_append (ifile, "SEQ cmd_reweight = reweight '=' expr")
	call ifile_append (ifile, "KEY cuts")
	call ifile_append (ifile, "KEY scale")
	call ifile_append (ifile, "KEY factorization_scale")
	call ifile_append (ifile, "KEY renormalization_scale")
	call ifile_append (ifile, "KEY weight")
	call ifile_append (ifile, "KEY selection")
	call ifile_append (ifile, "KEY reweight")
	call ifile_append (ifile, "SEQ cmd_process = process process_id '=' " &
	// "process_prt '=>' prt_state_list options?")
	call ifile_append (ifile, "KEY process")
	call ifile_append (ifile, "KEY '=>'")
	call ifile_append (ifile, "LIS process_prt = cexpr+")
	call ifile_append (ifile, "LIS prt_state_list = prt_state_sum+")
	call ifile_append (ifile, "SEQ prt_state_sum = " &
	// "prt_state prt_state_addition*")
	call ifile_append (ifile, "SEQ prt_state_addition = '+' prt_state")
	call ifile_append (ifile, "ALT prt_state = grouped_prt_state_list \| cexpr")
	call ifile_append (ifile, "GRO grouped_prt_state_list = " &
	// "( prt_state_list )")
	call ifile_append (ifile, "SEQ cmd_compile = compile_cmd options?")
	call ifile_append (ifile, "SEQ compile_cmd = compile_clause compile_arg?")
	call ifile_append (ifile, "SEQ compile_clause = compile exec_name_spec?")
	call ifile_append (ifile, "KEY compile")
	call ifile_append (ifile, "SEQ exec_name_spec = as exec_name")
	call ifile_append (ifile, "KEY as")
	call ifile_append (ifile, "ALT exec_name = exec_id \| string_literal")
	call ifile_append (ifile, "IDE exec_id")
	call ifile_append (ifile, "ARG compile_arg = ( lib_name* )")
	call ifile_append (ifile, "SEQ cmd_exec = exec exec_arg")
	call ifile_append (ifile, "KEY exec")
	call ifile_append (ifile, "ARG exec_arg = ( sexpr )")
	call ifile_append (ifile, "SEQ cmd_beams = beams '=' beam_def")
	call ifile_append (ifile, "KEY beams")
	call ifile_append (ifile, "SEQ beam_def = beam_spec strfun_seq*")
	call ifile_append (ifile, "SEQ beam_spec = beam_list")
	call ifile_append (ifile, "LIS beam_list = cexpr, cexpr?")
	call ifile_append (ifile, "SEQ cmd_beams_pol_density = " &
	// "beams_pol_density '=' beams_pol_spec")
	call ifile_append (ifile, "KEY beams_pol_density")
	call ifile_append (ifile, "LIS beams_pol_spec = smatrix, smatrix?")
	call ifile_append (ifile, "SEQ smatrix = '@' smatrix_arg")
	! call ifile_append (ifile, "KEY '@'") !!! Key already exists
	call ifile_append (ifile, "ARG smatrix_arg = ( sentry* )")
	call ifile_append (ifile, "SEQ sentry = expr extra_sentry*")
	call ifile_append (ifile, "SEQ extra_sentry = ':' expr")
	call ifile_append (ifile, "SEQ cmd_beams_pol_fraction = " &
	// "beams_pol_fraction '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_pol_fraction")
	call ifile_append (ifile, "SEQ cmd_beams_momentum = " &
	// "beams_momentum '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_momentum")
	call ifile_append (ifile, "SEQ cmd_beams_theta = " &
	// "beams_theta '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_theta")
	call ifile_append (ifile, "SEQ cmd_beams_phi = " &
	// "beams_phi '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_phi")
	call ifile_append (ifile, "LIS beams_par_spec = expr, expr?")
	call ifile_append (ifile, "SEQ strfun_seq = '=>' strfun_pair")
	call ifile_append (ifile, "LIS strfun_pair = strfun_def, strfun_def?")
	call ifile_append (ifile, "SEQ strfun_def = strfun_id")
	call ifile_append (ifile, "ALT strfun_id = " &
	// "none \| lhapdf \| lhapdf_photon \| pdf_builtin \| pdf_builtin_photon \| " &
	// "isr \| epa \| ewa \| circe1 \| circe2 \| energy_scan \| " &
	// "gaussian \| beam_events")
	call ifile_append (ifile, "KEY none")
	call ifile_append (ifile, "KEY lhapdf")
	call ifile_append (ifile, "KEY lhapdf_photon")
	call ifile_append (ifile, "KEY pdf_builtin")
	call ifile_append (ifile, "KEY pdf_builtin_photon")
	call ifile_append (ifile, "KEY isr")
	call ifile_append (ifile, "KEY epa")
	call ifile_append (ifile, "KEY ewa")
	call ifile_append (ifile, "KEY circe1")
	call ifile_append (ifile, "KEY circe2")
	call ifile_append (ifile, "KEY energy_scan")
	call ifile_append (ifile, "KEY gaussian")
	call ifile_append (ifile, "KEY beam_events")
	call ifile_append (ifile, "SEQ cmd_integrate = " &
	// "integrate proc_arg options?")
	call ifile_append (ifile, "KEY integrate")
	call ifile_append (ifile, "ARG proc_arg = ( proc_id* )")
	call ifile_append (ifile, "IDE proc_id")
	call ifile_append (ifile, "SEQ cmd_iterations = " &
	// "iterations '=' iterations_list")
	call ifile_append (ifile, "KEY iterations")
	call ifile_append (ifile, "LIS iterations_list = iterations_spec+")
	call ifile_append (ifile, "ALT iterations_spec = it_spec")
	call ifile_append (ifile, "SEQ it_spec = expr calls_spec adapt_spec?")
	call ifile_append (ifile, "SEQ calls_spec = ':' expr")
	call ifile_append (ifile, "SEQ adapt_spec = ':' sexpr")
	call ifile_append (ifile, "SEQ cmd_components = " &
	// "active '=' component_list")
	call ifile_append (ifile, "KEY active")
	call ifile_append (ifile, "LIS component_list = sexpr+")
	call ifile_append (ifile, "SEQ cmd_sample_format = " &
	// "sample_format '=' event_format_list")
	call ifile_append (ifile, "KEY sample_format")
	call ifile_append (ifile, "LIS event_format_list = event_format+")
	call ifile_append (ifile, "IDE event_format")
	call ifile_append (ifile, "SEQ cmd_observable = " &
	// "observable analysis_tag options?")
	call ifile_append (ifile, "KEY observable")
	call ifile_append (ifile, "SEQ cmd_histogram = " &
	// "histogram analysis_tag histogram_arg " &
	// "options?")
	call ifile_append (ifile, "KEY histogram")
	call ifile_append (ifile, "ARG histogram_arg = (expr, expr, expr?)")
	call ifile_append (ifile, "SEQ cmd_plot = plot analysis_tag options?")
	call ifile_append (ifile, "KEY plot")
	call ifile_append (ifile, "SEQ cmd_graph = graph graph_term '=' graph_def")
	call ifile_append (ifile, "KEY graph")
	call ifile_append (ifile, "SEQ graph_term = analysis_tag options?")
	call ifile_append (ifile, "SEQ graph_def = graph_term graph_append*")
	call ifile_append (ifile, "SEQ graph_append = '&' graph_term")
	call ifile_append (ifile, "SEQ cmd_analysis = analysis '=' lexpr")
	call ifile_append (ifile, "KEY analysis")
	call ifile_append (ifile, "SEQ cmd_alt_setup = " &
	// "alt_setup '=' option_list_expr")
	call ifile_append (ifile, "KEY alt_setup")
	call ifile_append (ifile, "ALT option_list_expr = " &
	// "grouped_option_list \| option_list")
	call ifile_append (ifile, "GRO grouped_option_list = ( option_list_expr )")
	call ifile_append (ifile, "LIS option_list = options+")
	call ifile_append (ifile, "SEQ cmd_open_out = open_out open_arg options?")
	call ifile_append (ifile, "SEQ cmd_close_out = close_out open_arg options?")
	call ifile_append (ifile, "KEY open_out")
	call ifile_append (ifile, "KEY close_out")
	call ifile_append (ifile, "ARG open_arg = (sexpr)")
	call ifile_append (ifile, "SEQ cmd_printf = printf_cmd options?")
	call ifile_append (ifile, "SEQ printf_cmd = printf_clause sprintf_args?")
	call ifile_append (ifile, "SEQ printf_clause = printf sexpr")
	call ifile_append (ifile, "KEY printf")
	call ifile_append (ifile, "SEQ cmd_record = record_cmd")
	call ifile_append (ifile, "SEQ cmd_unstable = " &
	// "unstable cexpr unstable_arg options?")
	call ifile_append (ifile, "KEY unstable")
	call ifile_append (ifile, "ARG unstable_arg = ( proc_id* )")
	call ifile_append (ifile, "SEQ cmd_stable = stable stable_list options?")
	call ifile_append (ifile, "KEY stable")
	call ifile_append (ifile, "LIS stable_list = cexpr+")
	call ifile_append (ifile, "KEY polarized")
	call ifile_append (ifile, "SEQ cmd_polarized = polarized polarized_list options?")
	call ifile_append (ifile, "LIS polarized_list = cexpr+")
	call ifile_append (ifile, "KEY unpolarized")
	call ifile_append (ifile, "SEQ cmd_unpolarized = unpolarized unpolarized_list options?")
	call ifile_append (ifile, "LIS unpolarized_list = cexpr+")
	call ifile_append (ifile, "SEQ cmd_simulate = " &
	// "simulate proc_arg options?")
	call ifile_append (ifile, "KEY simulate")
	call ifile_append (ifile, "SEQ cmd_rescan = " &
	// "rescan sexpr proc_arg options?")
	call ifile_append (ifile, "KEY rescan")
	call ifile_append (ifile, "SEQ cmd_scan = scan scan_var scan_body?")
	call ifile_append (ifile, "KEY scan")
	call ifile_append (ifile, "ALT scan_var = " &
	// "scan_log_decl \| scan_log \| " &
	// "scan_int \| scan_real \| scan_complex \| scan_num \| " &
	// "scan_string_decl \| scan_string \| scan_alias \| " &
	// "scan_cuts \| scan_weight \| " &
	// "scan_scale \| scan_ren_scale \| scan_fac_scale \| " &
	// "scan_selection \| scan_reweight \| scan_analysis \| " &
	// "scan_model \| scan_library")
	call ifile_append (ifile, "SEQ scan_log_decl = logical scan_log")
	call ifile_append (ifile, "SEQ scan_log = '?' var_name '=' scan_log_arg")
	call ifile_append (ifile, "ARG scan_log_arg = ( lexpr* )")
	call ifile_append (ifile, "SEQ scan_int = int var_name '=' scan_num_arg")
	call ifile_append (ifile, "SEQ scan_real = real var_name '=' scan_num_arg")
	call ifile_append (ifile, "SEQ scan_complex = " &
	// "complex var_name '=' scan_num_arg")
	call ifile_append (ifile, "SEQ scan_num = var_name '=' scan_num_arg")
	call ifile_append (ifile, "ARG scan_num_arg = ( range* )")
	call ifile_append (ifile, "ALT range = grouped_range \| range_expr")
	call ifile_append (ifile, "GRO grouped_range = ( range_expr )")
	call ifile_append (ifile, "SEQ range_expr = expr range_spec?")
	call ifile_append (ifile, "SEQ range_spec = '=>' expr step_spec?")
	call ifile_append (ifile, "SEQ step_spec = step_op expr")
	call ifile_append (ifile, "ALT step_op = " &
	// "'/+' \| '/-' \| '/' \| '//' \| '/+/' \| '//'")
	call ifile_append (ifile, "KEY '/+'")
	call ifile_append (ifile, "KEY '/-'")
	call ifile_append (ifile, "KEY '/*'")
	call ifile_append (ifile, "KEY '//'")
	call ifile_append (ifile, "KEY '/+/'")
	call ifile_append (ifile, "KEY '/*/'")
	call ifile_append (ifile, "SEQ scan_string_decl = string scan_string")
	call ifile_append (ifile, "SEQ scan_string = " &
	// "'$' var_name '=' scan_string_arg")
	call ifile_append (ifile, "ARG scan_string_arg = ( sexpr* )")
	call ifile_append (ifile, "SEQ scan_alias = " &
	// "alias var_name '=' scan_alias_arg")
	call ifile_append (ifile, "ARG scan_alias_arg = ( cexpr* )")
	call ifile_append (ifile, "SEQ scan_cuts = cuts '=' scan_lexpr_arg")
	call ifile_append (ifile, "ARG scan_lexpr_arg = ( lexpr* )")
	call ifile_append (ifile, "SEQ scan_scale = scale '=' scan_expr_arg")
	call ifile_append (ifile, "ARG scan_expr_arg = ( expr* )")
	call ifile_append (ifile, "SEQ scan_fac_scale = " &
	// "factorization_scale '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_ren_scale = " &
	// "renormalization_scale '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_weight = weight '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_selection = selection '=' scan_lexpr_arg")
	call ifile_append (ifile, "SEQ scan_reweight = reweight '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_analysis = analysis '=' scan_lexpr_arg")
	call ifile_append (ifile, "SEQ scan_model = model '=' scan_model_arg")
	call ifile_append (ifile, "ARG scan_model_arg = ( model_name* )")
	call ifile_append (ifile, "SEQ scan_library = library '=' scan_library_arg")
	call ifile_append (ifile, "ARG scan_library_arg = ( lib_name* )")
	call ifile_append (ifile, "GRO scan_body = '{' command_list '}'")
	call ifile_append (ifile, "SEQ cmd_if = " &
	// "if lexpr then command_list elsif_clauses else_clause endif")
	call ifile_append (ifile, "SEQ elsif_clauses = cmd_elsif*")
	call ifile_append (ifile, "SEQ cmd_elsif = elsif lexpr then command_list")
	call ifile_append (ifile, "SEQ else_clause = cmd_else?")
	call ifile_append (ifile, "SEQ cmd_else = else command_list")
	call ifile_append (ifile, "SEQ cmd_include = include include_arg")
	call ifile_append (ifile, "KEY include")
	call ifile_append (ifile, "ARG include_arg = ( string_literal )")
	call ifile_append (ifile, "SEQ cmd_quit = quit_cmd quit_arg?")
	call ifile_append (ifile, "ALT quit_cmd = quit \| exit")
	call ifile_append (ifile, "KEY quit")
	call ifile_append (ifile, "KEY exit")
	call ifile_append (ifile, "ARG quit_arg = ( expr )")
	call ifile_append (ifile, "SEQ cmd_export = export show_arg options?")
	call ifile_append (ifile, "KEY export")
	call ifile_append (ifile, "SEQ cmd_write_analysis = " &
	// "write_analysis_clause options?")
	call ifile_append (ifile, "SEQ cmd_compile_analysis = " &
	// "compile_analysis_clause options?")
	call ifile_append (ifile, "SEQ write_analysis_clause = " &
	// "write_analysis write_analysis_arg?")
	call ifile_append (ifile, "SEQ compile_analysis_clause = " &
	// "compile_analysis write_analysis_arg?")
	call ifile_append (ifile, "KEY write_analysis")
	call ifile_append (ifile, "KEY compile_analysis")
	call ifile_append (ifile, "ARG write_analysis_arg = ( analysis_tag* )")
	call ifile_append (ifile, "SEQ cmd_nlo = " &
	// "nlo_calculation '=' nlo_calculation_list")
	call ifile_append (ifile, "KEY nlo_calculation")
	call ifile_append (ifile, "LIS nlo_calculation_list = nlo_comp+")
	call ifile_append (ifile, "ALT nlo_comp = " // &
	"full \| born \| real \| virtual \| dglap \| subtraction \| " // &
	"mismatch \| GKS")
	call ifile_append (ifile, "KEY full")
	call ifile_append (ifile, "KEY born")
	call ifile_append (ifile, "KEY virtual")
	call ifile_append (ifile, "KEY dglap")
	call ifile_append (ifile, "KEY subtraction")
	call ifile_append (ifile, "KEY mismatch")
	call ifile_append (ifile, "KEY GKS")
	call define_expr_syntax (ifile, particles=.true., analysis=.true.)
	end subroutine define_cmd_list_syntax

	@ %def define_cmd_list_syntax
	<<Commands: public>>=
	public :: lexer_init_cmd_list
	<<Commands: sub interfaces>>=
	module subroutine lexer_init_cmd_list (lexer, parent_lexer)
	type(lexer_t), intent(out) :: lexer
	type(lexer_t), intent(in), optional, target :: parent_lexer
	end subroutine lexer_init_cmd_list
	<<Commands: procedures>>=
	module subroutine lexer_init_cmd_list (lexer, parent_lexer)
	type(lexer_t), intent(out) :: lexer
	type(lexer_t), intent(in), optional, target :: parent_lexer
	call lexer_init (lexer, &
	comment_chars = "#!", &
	quote_chars = '"', &
	quote_match = '"', &
	single_chars = "()[]{},;:&%?$@", &
	special_class = [ "+-*/^", "<>=~ " ] , &
	keyword_list = syntax_get_keyword_list_ptr (syntax_cmd_list), &
	parent = parent_lexer)
	end subroutine lexer_init_cmd_list

	@ %def lexer_init_cmd_list
	@
	\subsection{Unit Tests}
	Test module, followed by the corresponding implementation module.
	<<[[commands_ut.f90]]>>=
	<<File header>>

	module commands_ut
	use unit_tests
	use system_dependencies, only: MPOST_AVAILABLE
	use commands_uti

	<<Standard module head>>

	<<Commands: public test>>

	contains

	<<Commands: test driver>>

	end module commands_ut
	@ %def commands_ut
	@
	<<[[commands_uti.f90]]>>=
	<<File header>>

	module commands_uti

	<<Use kinds>>
	use kinds, only: i64
	<<Use strings>>
	use io_units
	use ifiles
	use parser
	use interactions, only: reset_interaction_counter
	use prclib_stacks
	use analysis
	use variables, only: var_list_t
	use models
	use slha_interface
	use rt_data
	use event_base, only: generic_event_t, event_callback_t
	use commands

	<<Standard module head>>

	<<Commands: test declarations>>

	<<Commands: test auxiliary types>>

	contains

	<<Commands: tests>>

	<<Commands: test auxiliary>>

	end module commands_uti

	@ %def commands_uti
	@ API: driver for the unit tests below.
	<<Commands: public test>>=
	public :: commands_test
	<<Commands: test driver>>=
	subroutine commands_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Commands: execute tests>>
	end subroutine commands_test

	@ %def commands_test
	@
	\subsubsection{Prepare Sindarin code}
	This routine parses an internal file, prints the parse tree, and
	returns a parse node to the root. We use the routine in the tests
	below.
	<<Commands: public test auxiliary>>=
	public :: parse_ifile
	<<Commands: test auxiliary>>=
	subroutine parse_ifile (ifile, pn_root, u)
	use ifiles
	use lexers
	use parser
	use commands
	type(ifile_t), intent(in) :: ifile
	type(parse_node_t), pointer, intent(out) :: pn_root
	integer, intent(in), optional :: u
	type(stream_t), target :: stream
	type(lexer_t), target :: lexer
	type(parse_tree_t) :: parse_tree

	call lexer_init_cmd_list (lexer)
	call stream_init (stream, ifile)
	call lexer_assign_stream (lexer, stream)

	call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
	if (present (u)) call parse_tree_write (parse_tree, u)
	pn_root => parse_tree%get_root_ptr ()

	call stream_final (stream)
	call lexer_final (lexer)
	end subroutine parse_ifile

	@ %def parse_ifile
	@
	\subsubsection{Empty command list}
	Compile and execute an empty command list. Should do nothing but
	test the integrity of the workflow.
	<<Commands: execute tests>>=
	call test (commands_1, "commands_1", &
	"empty command list", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_1
	<<Commands: tests>>=
	subroutine commands_1 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_1"
	write (u, "(A)") "* Purpose: compile and execute empty command list"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Parse empty file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"

	if (associated (pn_root)) then
	call command_list%compile (pn_root, global)
	end if

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call global%activate ()
	call command_list%execute (global)
	call global%deactivate ()

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call syntax_cmd_list_final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_1"

	end subroutine commands_1

	@ %def commands_1
	@
	\subsubsection{Read model}
	Execute a [[model]] assignment.
	<<Commands: execute tests>>=
	call test (commands_2, "commands_2", &
	"model", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_2
	<<Commands: tests>>=
	subroutine commands_2 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_2"
	write (u, "(A)") "* Purpose: set model"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')

	call ifile_write (ifile, u)

	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_2"

	end subroutine commands_2

	@ %def commands_2
	@
	\subsubsection{Declare Process}
	Read a model, then declare a process. The process library is allocated
	explicitly. For the process definition, We take the default ([[omega]])
	method. Since we do not compile, \oMega\ is not actually called.
	<<Commands: execute tests>>=
	call test (commands_3, "commands_3", &
	"process declaration", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_3
	<<Commands: tests>>=
	subroutine commands_3 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_3"
	write (u, "(A)") "* Purpose: define process"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd3"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t3 = s, s => s, s')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_3"

	end subroutine commands_3

	@ %def commands_3
	@
	\subsubsection{Compile Process}
	Read a model, then declare a process and compile the library. The process
	library is allocated explicitly. For the process definition, We take the
	default ([[unit_test]]) method. There is no external code, so compilation of
	the library is merely a formal status change.
	<<Commands: execute tests>>=
	call test (commands_4, "commands_4", &
	"compilation", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_4
	<<Commands: tests>>=
	subroutine commands_4 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_4"
	write (u, "(A)") "* Purpose: define process and compile library"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd4"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t4 = s, s => s, s')
	call ifile_append (ifile, 'compile ("lib_cmd4")')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_4"

	end subroutine commands_4

	@ %def commands_4
	@
	\subsubsection{Integrate Process}
	Read a model, then declare a process, compile the library, and
	integrate over phase space. We take the
	default ([[unit_test]]) method and use the simplest methods of
	phase-space parameterization and integration.
	<<Commands: execute tests>>=
	call test (commands_5, "commands_5", &
	"integration", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_5
	<<Commands: tests>>=
	subroutine commands_5 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_5"
	write (u, "(A)") "* Purpose: define process, iterations, and integrate"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_int (var_str ("seed"), 0, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd5"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t5 = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (t5)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call reset_interaction_counter ()
	call command_list%execute (global)

	call global%it_list%write (u)
	write (u, "(A)")
	call global%process_stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_5"

	end subroutine commands_5

	@ %def commands_5
	@
	\subsubsection{Variables}
	Set intrinsic and user-defined variables.
	<<Commands: execute tests>>=
	call test (commands_6, "commands_6", &
	"variables", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_6
	<<Commands: tests>>=
	subroutine commands_6 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_6"
	write (u, "(A)") "* Purpose: define and set variables"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()
	call global%write_vars (u, [ &
	var_str ("$run_id"), &
	var_str ("?unweighted"), &
	var_str ("sqrts")])

	write (u, "(A)")
	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$run_id = "run1"')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'sqrts = 1000')
	call ifile_append (ifile, 'int j = 10')
	call ifile_append (ifile, 'real x = 1000.')
	call ifile_append (ifile, 'complex z = 5')
	call ifile_append (ifile, 'string $text = "abcd"')
	call ifile_append (ifile, 'logical ?flag = true')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_vars (u, [ &
	var_str ("$run_id"), &
	var_str ("?unweighted"), &
	var_str ("sqrts"), &
	var_str ("j"), &
	var_str ("x"), &
	var_str ("z"), &
	var_str ("$text"), &
	var_str ("?flag")])


	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call syntax_cmd_list_final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_6"

	end subroutine commands_6

	@ %def commands_6
	@
	\subsubsection{Process library}
	Open process libraries explicitly.
	<<Commands: execute tests>>=
	call test (commands_7, "commands_7", &
	"process library", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_7
	<<Commands: tests>>=
	subroutine commands_7 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_7"
	write (u, "(A)") "* Purpose: declare process libraries"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()
	call global%var_list%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	global%os_data%fc = "Fortran-compiler"
	global%os_data%fcflags = "Fortran-flags"
	global%os_data%fclibs = "Fortran-libs"

	write (u, "(A)")
	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'library = "lib_cmd7_1"')
	call ifile_append (ifile, 'library = "lib_cmd7_2"')
	call ifile_append (ifile, 'library = "lib_cmd7_1"')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_libraries (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call syntax_cmd_list_final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_7"

	end subroutine commands_7

	@ %def commands_7
	@
	\subsubsection{Generate events}
	Read a model, then declare a process, compile the library, and
	generate weighted events. We take the
	default ([[unit_test]]) method and use the simplest methods of
	phase-space parameterization and integration.
	<<Commands: execute tests>>=
	call test (commands_8, "commands_8", &
	"event generation", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_8
	<<Commands: tests>>=
	subroutine commands_8 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_8"
	write (u, "(A)") "* Purpose: define process, integrate, generate events"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd8"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_8_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (commands_8_p)')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'n_events = 3')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'simulate (commands_8_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call command_list%execute (global)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_8"

	end subroutine commands_8

	@ %def commands_8
	@
	\subsubsection{Define cuts}
	Declare a cut expression.
	<<Commands: execute tests>>=
	call test (commands_9, "commands_9", &
	"cuts", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_9
	<<Commands: tests>>=
	subroutine commands_9 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(string_t), dimension(0) :: no_vars

	write (u, "(A)") "* Test output: commands_9"
	write (u, "(A)") "* Purpose: define cuts"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'cuts = all Pt > 0 [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write (u, vars = no_vars)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_9"

	end subroutine commands_9

	@ %def commands_9
	@
	\subsubsection{Beams}
	Define beam setup.
	<<Commands: execute tests>>=
	call test (commands_10, "commands_10", &
	"beams", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_10
	<<Commands: tests>>=
	subroutine commands_10 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_10"
	write (u, "(A)") "* Purpose: define beams"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = QCD')
	call ifile_append (ifile, 'sqrts = 1000')
	call ifile_append (ifile, 'beams = p, p')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_beams (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_10"

	end subroutine commands_10

	@ %def commands_10
	@
	\subsubsection{Structure functions}
	Define beam setup with structure functions
	<<Commands: execute tests>>=
	call test (commands_11, "commands_11", &
	"structure functions", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_11
	<<Commands: tests>>=
	subroutine commands_11 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_11"
	write (u, "(A)") "* Purpose: define beams with structure functions"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = QCD')
	call ifile_append (ifile, 'sqrts = 1100')
	call ifile_append (ifile, 'beams = p, p => lhapdf => pdf_builtin, isr')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_beams (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_11"

	end subroutine commands_11

	@ %def commands_11
	@
	\subsubsection{Rescan events}
	Read a model, then declare a process, compile the library, and
	generate weighted events. We take the
	default ([[unit_test]]) method and use the simplest methods of
	phase-space parameterization and integration. Then, rescan the
	generated event sample.
	<<Commands: execute tests>>=
	call test (commands_12, "commands_12", &
	"event rescanning", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_12
	<<Commands: tests>>=
	subroutine commands_12 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_12"
	write (u, "(A)") "* Purpose: generate events and rescan"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()

	call global%global_init ()
	call global%var_list%append_log (&
	var_str ("?rebuild_phase_space"), .false., &
	intrinsic=.true.)
	call global%var_list%append_log (&
	var_str ("?rebuild_grids"), .false., &
	intrinsic=.true.)
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd12"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_12_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (commands_12_p)')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'n_events = 3')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'simulate (commands_12_p)')
	call ifile_append (ifile, '?write_raw = false')
	call ifile_append (ifile, 'rescan "commands_12_p" (commands_12_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call command_list%execute (global)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_12"

	end subroutine commands_12

	@ %def commands_12
	@
	\subsubsection{Event Files}
	Set output formats for event files.
	<<Commands: execute tests>>=
	call test (commands_13, "commands_13", &
	"event output formats", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_13
	<<Commands: tests>>=
	subroutine commands_13 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib
	logical :: exist

	write (u, "(A)") "* Test output: commands_13"
	write (u, "(A)") "* Purpose: generate events and rescan"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd13"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_13_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (commands_13_p)')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'n_events = 1')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'sample_format = weight_stream')
	call ifile_append (ifile, 'simulate (commands_13_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call command_list%execute (global)

	write (u, "(A)")
	write (u, "(A)") "* Verify output files"
	write (u, "(A)")

	inquire (file = "commands_13_p.evx", exist = exist)
	if (exist) write (u, "(1x,A)") "raw"

	inquire (file = "commands_13_p.weights.dat", exist = exist)
	if (exist) write (u, "(1x,A)") "weight_stream"

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_13"

	end subroutine commands_13

	@ %def commands_13
	@
	\subsubsection{Compile Empty Libraries}
	(This is a regression test:) Declare two empty libraries and compile them.
	<<Commands: execute tests>>=
	call test (commands_14, "commands_14", &
	"empty libraries", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_14
	<<Commands: tests>>=
	subroutine commands_14 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_14"
	write (u, "(A)") "* Purpose: define and compile empty libraries"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_cmd_list_init ()

	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'library = "lib1"')
	call ifile_append (ifile, 'library = "lib2"')
	call ifile_append (ifile, 'compile ()')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()

	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_14"

	end subroutine commands_14

	@ %def commands_14
	@
	\subsubsection{Compile Process}
	Read a model, then declare a process and compile the library. The process
	library is allocated explicitly. For the process definition, We take the
	default ([[unit_test]]) method. There is no external code, so compilation of
	the library is merely a formal status change.
	<<Commands: execute tests>>=
	call test (commands_15, "commands_15", &
	"compilation", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_15
	<<Commands: tests>>=
	subroutine commands_15 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_15"
	write (u, "(A)") "* Purpose: define process and compile library"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd15"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t15 = s, s => s, s')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (t15)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_15"

	end subroutine commands_15

	@ %def commands_15
	@
	\subsubsection{Observable}
	Declare an observable, fill it and display.
	<<Commands: execute tests>>=
	call test (commands_16, "commands_16", &
	"observables", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_16
	<<Commands: tests>>=
	subroutine commands_16 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_16"
	write (u, "(A)") "* Purpose: declare an observable"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$obs_label = "foo"')
	call ifile_append (ifile, '$obs_unit = "cm"')
	call ifile_append (ifile, '$title = "Observable foo"')
	call ifile_append (ifile, '$description = "This is observable foo"')
	call ifile_append (ifile, 'observable foo')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Record two data items"
	write (u, "(A)")

	call analysis_record_data (var_str ("foo"), 1._default)
	call analysis_record_data (var_str ("foo"), 3._default)

	write (u, "(A)") "* Display analysis store"
	write (u, "(A)")

	call analysis_write (u, verbose=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_16"

	end subroutine commands_16

	@ %def commands_16
	@
	\subsubsection{Histogram}
	Declare a histogram, fill it and display.
	<<Commands: execute tests>>=
	call test (commands_17, "commands_17", &
	"histograms", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_17
	<<Commands: tests>>=
	subroutine commands_17 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(string_t), dimension(3) :: name
	integer :: i

	write (u, "(A)") "* Test output: commands_17"
	write (u, "(A)") "* Purpose: declare histograms"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$obs_label = "foo"')
	call ifile_append (ifile, '$obs_unit = "cm"')
	call ifile_append (ifile, '$title = "Histogram foo"')
	call ifile_append (ifile, '$description = "This is histogram foo"')
	call ifile_append (ifile, 'histogram foo (0,5,1)')
	call ifile_append (ifile, '$title = "Histogram bar"')
	call ifile_append (ifile, '$description = "This is histogram bar"')
	call ifile_append (ifile, 'n_bins = 2')
	call ifile_append (ifile, 'histogram bar (0,5)')
	call ifile_append (ifile, '$title = "Histogram gee"')
	call ifile_append (ifile, '$description = "This is histogram gee"')
	call ifile_append (ifile, '?normalize_bins = true')
	call ifile_append (ifile, 'histogram gee (0,5)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Record two data items"
	write (u, "(A)")

	name(1) = "foo"
	name(2) = "bar"
	name(3) = "gee"

	do i = 1, 3
	call analysis_record_data (name(i), 0.1_default, &
	weight = 0.25_default)
	call analysis_record_data (name(i), 3.1_default)
	call analysis_record_data (name(i), 4.1_default, &
	excess = 0.5_default)
	call analysis_record_data (name(i), 7.1_default)
	end do

	write (u, "(A)") "* Display analysis store"
	write (u, "(A)")

	call analysis_write (u, verbose=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_17"

	end subroutine commands_17

	@ %def commands_17
	@
	\subsubsection{Plot}
	Declare a plot, fill it and display contents.
	<<Commands: execute tests>>=
	call test (commands_18, "commands_18", &
	"plots", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_18
	<<Commands: tests>>=
	subroutine commands_18 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_18"
	write (u, "(A)") "* Purpose: declare a plot"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$obs_label = "foo"')
	call ifile_append (ifile, '$obs_unit = "cm"')
	call ifile_append (ifile, '$title = "Plot foo"')
	call ifile_append (ifile, '$description = "This is plot foo"')
	call ifile_append (ifile, '$x_label = "x axis"')
	call ifile_append (ifile, '$y_label = "y axis"')
	call ifile_append (ifile, '?x_log = false')
	call ifile_append (ifile, '?y_log = true')
	call ifile_append (ifile, 'x_min = -1')
	call ifile_append (ifile, 'x_max = 1')
	call ifile_append (ifile, 'y_min = 0.1')
	call ifile_append (ifile, 'y_max = 1000')
	call ifile_append (ifile, 'plot foo')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Record two data items"
	write (u, "(A)")

	call analysis_record_data (var_str ("foo"), 0._default, 20._default, &
	xerr = 0.25_default)
	call analysis_record_data (var_str ("foo"), 0.5_default, 0.2_default, &
	yerr = 0.07_default)
	call analysis_record_data (var_str ("foo"), 3._default, 2._default)

	write (u, "(A)") "* Display analysis store"
	write (u, "(A)")

	call analysis_write (u, verbose=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_18"

	end subroutine commands_18

	@ %def commands_18
	@
	\subsubsection{Graph}
	Combine two (empty) plots to a graph.
	<<Commands: execute tests>>=
	call test (commands_19, "commands_19", &
	"graphs", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_19
	<<Commands: tests>>=
	subroutine commands_19 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_19"
	write (u, "(A)") "* Purpose: combine two plots to a graph"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'plot a')
	call ifile_append (ifile, 'plot b')
	call ifile_append (ifile, '$title = "Graph foo"')
	call ifile_append (ifile, '$description = "This is graph foo"')
	call ifile_append (ifile, 'graph foo = a & b')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis object"
	write (u, "(A)")

	call analysis_write (var_str ("foo"), u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_19"

	end subroutine commands_19

	@ %def commands_19
	@
	\subsubsection{Record Data}
	Record data in previously allocated analysis objects.
	<<Commands: execute tests>>=
	call test (commands_20, "commands_20", &
	"record data", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_20
	<<Commands: tests>>=
	subroutine commands_20 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_20"
	write (u, "(A)") "* Purpose: record data"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable, histogram, plot"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	call analysis_init_observable (var_str ("o"))
	call analysis_init_histogram (var_str ("h"), 0._default, 1._default, 3, &
	normalize_bins = .false.)
	call analysis_init_plot (var_str ("p"))

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'record o (1.234)')
	call ifile_append (ifile, 'record h (0.5)')
	call ifile_append (ifile, 'record p (1, 2)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis object"
	write (u, "(A)")

	call analysis_write (u, verbose = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_20"

	end subroutine commands_20

	@ %def commands_20
	@
	\subsubsection{Analysis}
	Declare an analysis expression and use it to fill an observable during
	event generation.
	<<Commands: execute tests>>=
	call test (commands_21, "commands_21", &
	"analysis expression", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_21
	<<Commands: tests>>=
	subroutine commands_21 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_21"
	write (u, "(A)") "* Purpose: create and use analysis expression"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd8"))
	call global%add_prclib (lib)

	call analysis_init_observable (var_str ("m"))

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_21_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:100')
	call ifile_append (ifile, 'integrate (commands_21_p)')
	call ifile_append (ifile, '?unweighted = true')
	call ifile_append (ifile, 'n_events = 3')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'observable m')
	call ifile_append (ifile, 'analysis = record m (eval M [s])')
	call ifile_append (ifile, 'simulate (commands_21_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis object"
	write (u, "(A)")

	call analysis_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_21"

	end subroutine commands_21

	@ %def commands_21
	@
	\subsubsection{Write Analysis}
	Write accumulated analysis data to file.
	<<Commands: execute tests>>=
	call test (commands_22, "commands_22", &
	"write analysis", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_22
	<<Commands: tests>>=
	subroutine commands_22 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	integer :: u_file, iostat
	logical :: exist
	character(80) :: buffer

	write (u, "(A)") "* Test output: commands_22"
	write (u, "(A)") "* Purpose: write analysis data"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	call analysis_init_observable (var_str ("m"))
	call analysis_record_data (var_str ("m"), 125._default)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$out_file = "commands_22.dat"')
	call ifile_append (ifile, 'write_analysis')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis data"
	write (u, "(A)")

	inquire (file = "commands_22.dat", exist = exist)
	if (.not. exist) then
	write (u, "(A)") "ERROR: File commands_22.dat not found"
	return
	end if

	u_file = free_unit ()
	open (u_file, file = "commands_22.dat", &
	action = "read", status = "old")
	do
	read (u_file, "(A)", iostat = iostat) buffer
	if (iostat /= 0) exit
	write (u, "(A)") trim (buffer)
	end do
	close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_22"

	end subroutine commands_22

	@ %def commands_22
	@
	\subsubsection{Compile Analysis}
	Write accumulated analysis data to file and compile.
	<<Commands: execute tests>>=
	if (MPOST_AVAILABLE) then
	call test (commands_23, "commands_23", &
	"compile analysis", &
	u, results)
	end if
	<<Commands: test declarations>>=
	public :: commands_23
	<<Commands: tests>>=
	subroutine commands_23 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	integer :: u_file, iostat
	character(256) :: buffer
	logical :: exist
	type(graph_options_t) :: graph_options

	write (u, "(A)") "* Test output: commands_23"
	write (u, "(A)") "* Purpose: write and compile analysis data"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create and fill histogram"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	call graph_options%init ()
	call graph_options%set (title = var_str ("Histogram for test: commands 23"), &
	description = var_str ("This is a test."), &
	width_mm = 125, height_mm = 85)
	call analysis_init_histogram (var_str ("h"), &
	0._default, 10._default, 2._default, .false., &
	graph_options = graph_options)
	call analysis_record_data (var_str ("h"), 1._default)
	call analysis_record_data (var_str ("h"), 1._default)
	call analysis_record_data (var_str ("h"), 1._default)
	call analysis_record_data (var_str ("h"), 1._default)
	call analysis_record_data (var_str ("h"), 3._default)
	call analysis_record_data (var_str ("h"), 3._default)
	call analysis_record_data (var_str ("h"), 3._default)
	call analysis_record_data (var_str ("h"), 5._default)
	call analysis_record_data (var_str ("h"), 7._default)
	call analysis_record_data (var_str ("h"), 7._default)
	call analysis_record_data (var_str ("h"), 7._default)
	call analysis_record_data (var_str ("h"), 7._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$out_file = "commands_23.dat"')
	call ifile_append (ifile, 'compile_analysis')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Delete Postscript output"
	write (u, "(A)")

	inquire (file = "commands_23.ps", exist = exist)
	if (exist) then
	u_file = free_unit ()
	open (u_file, file = "commands_23.ps", action = "write", status = "old")
	close (u_file, status = "delete")
	end if
	inquire (file = "commands_23.ps", exist = exist)
	write (u, "(1x,A,L1)") "Postcript output exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* TeX file"
	write (u, "(A)")

	inquire (file = "commands_23.tex", exist = exist)
	if (.not. exist) then
	write (u, "(A)") "ERROR: File commands_23.tex not found"
	return
	end if

	u_file = free_unit ()
	open (u_file, file = "commands_23.tex", &
	action = "read", status = "old")
	do
	read (u_file, "(A)", iostat = iostat) buffer
	if (iostat /= 0) exit
	write (u, "(A)") trim (buffer)
	end do
	close (u_file)
	write (u, *)

	inquire (file = "commands_23.ps", exist = exist)
	write (u, "(1x,A,L1)") "Postcript output exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_23"

	end subroutine commands_23

	@ %def commands_23
	@
	\subsubsection{Histogram}
	Declare a histogram, fill it and display.
	<<Commands: execute tests>>=
	call test (commands_24, "commands_24", &
	"drawing options", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_24
	<<Commands: tests>>=
	subroutine commands_24 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_24"
	write (u, "(A)") "* Purpose: check graph and drawing options"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$title = "Title"')
	call ifile_append (ifile, '$description = "Description"')
	call ifile_append (ifile, '$x_label = "X Label"')
	call ifile_append (ifile, '$y_label = "Y Label"')
	call ifile_append (ifile, 'graph_width_mm = 111')
	call ifile_append (ifile, 'graph_height_mm = 222')
	call ifile_append (ifile, 'x_min = -11')
	call ifile_append (ifile, 'x_max = 22')
	call ifile_append (ifile, 'y_min = -33')
	call ifile_append (ifile, 'y_max = 44')
	call ifile_append (ifile, '$gmlcode_bg = "GML Code BG"')
	call ifile_append (ifile, '$gmlcode_fg = "GML Code FG"')
	call ifile_append (ifile, '$fill_options = "Fill Options"')
	call ifile_append (ifile, '$draw_options = "Draw Options"')
	call ifile_append (ifile, '$err_options = "Error Options"')
	call ifile_append (ifile, '$symbol = "Symbol"')
	call ifile_append (ifile, 'histogram foo (0,1)')
	call ifile_append (ifile, 'plot bar')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis store"
	write (u, "(A)")

	call analysis_write (u, verbose=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_24"

	end subroutine commands_24

	@ %def commands_24
	@
	\subsubsection{Local Environment}
	Declare a local environment.
	<<Commands: execute tests>>=
	call test (commands_25, "commands_25", &
	"local process environment", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_25
	<<Commands: tests>>=
	subroutine commands_25 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_25"
	write (u, "(A)") "* Purpose: declare local environment for process"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_cmd_list_init ()
	call global%global_init ()
	call global%var_list%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'library = "commands_25_lib"')
	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_25_p1 = g, g => g, g &
	&{ model = "QCD" }')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)
	call global%write_libraries (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_25"

	end subroutine commands_25

	@ %def commands_25
	@
	\subsubsection{Alternative Setups}
	Declare a list of alternative setups.
	<<Commands: execute tests>>=
	call test (commands_26, "commands_26", &
	"alternative setups", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_26
	<<Commands: tests>>=
	subroutine commands_26 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_26"
	write (u, "(A)") "* Purpose: declare alternative setups for simulation"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'int i = 0')
	call ifile_append (ifile, 'alt_setup = ({ i = 1 }, { i = 2 })')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_expr (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_26"

	end subroutine commands_26

	@ %def commands_26
	@
	\subsubsection{Unstable Particle}
	Define decay processes and declare a particle as unstable. Also check
	the commands stable, polarized, unpolarized.
	<<Commands: execute tests>>=
	call test (commands_27, "commands_27", &
	"unstable and polarized particles", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_27
	<<Commands: tests>>=
	subroutine commands_27 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_27"
	write (u, "(A)") "* Purpose: modify particle properties"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("commands_27_lib"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'ff = 0.4')
	call ifile_append (ifile, 'process d1 = s => f, fbar')
	call ifile_append (ifile, 'unstable s (d1)')
	call ifile_append (ifile, 'polarized f, fbar')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Show model"
	write (u, "(A)")

	call global%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Extra Input"
	write (u, "(A)")

	call ifile_final (ifile)
	call ifile_append (ifile, '?diagonal_decay = true')
	call ifile_append (ifile, 'unstable s (d1)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%final ()
	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Show model"
	write (u, "(A)")

	call global%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Extra Input"
	write (u, "(A)")

	call ifile_final (ifile)
	call ifile_append (ifile, '?isotropic_decay = true')
	call ifile_append (ifile, 'unstable s (d1)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%final ()
	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Show model"
	write (u, "(A)")

	call global%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Extra Input"
	write (u, "(A)")

	call ifile_final (ifile)
	call ifile_append (ifile, 'stable s')
	call ifile_append (ifile, 'unpolarized f')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%final ()
	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Show model"
	write (u, "(A)")

	call global%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_model_file_init ()
	call syntax_cmd_list_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_27"

	end subroutine commands_27

	@ %def commands_27
	@
	\subsubsection{Quit the program}
	Quit the program.
	<<Commands: execute tests>>=
	call test (commands_28, "commands_28", &
	"quit", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_28
	<<Commands: tests>>=
	subroutine commands_28 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root1, pn_root2
	type(string_t), dimension(0) :: no_vars

	write (u, "(A)") "* Test output: commands_28"
	write (u, "(A)") "* Purpose: quit the program"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file: quit without code"
	write (u, "(A)")

	call ifile_append (ifile, 'quit')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root1, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root1, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write (u, vars = no_vars)

	write (u, "(A)")
	write (u, "(A)") "* Input file: quit with code"
	write (u, "(A)")

	call ifile_final (ifile)
	call command_list%final ()
	call ifile_append (ifile, 'quit ( 3 + 4 )')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root2, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root2, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write (u, vars = no_vars)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_28"

	end subroutine commands_28

	@ %def commands_28
	@
	\subsubsection{SLHA interface}
	Testing commands steering the SLHA interface.
	<<Commands: execute tests>>=
	call test (commands_29, "commands_29", &
	"SLHA interface", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_29
	<<Commands: tests>>=
	subroutine commands_29 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(var_list_t), pointer :: model_vars
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_29"
	write (u, "(A)") "* Purpose: test SLHA interface"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call syntax_slha_init ()
	call global%global_init ()

	write (u, "(A)") "* Model MSSM, read SLHA file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "MSSM"')
	call ifile_append (ifile, '?slha_read_decays = true')
	call ifile_append (ifile, 'read_slha ("sps1ap_decays.slha")')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Model MSSM, default values:"
	write (u, "(A)")

	call global%model%write (u, verbose = .false., &
	show_vertices = .false., show_particles = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Selected global variables"
	write (u, "(A)")

	model_vars => global%model%get_var_list_ptr ()

	call model_vars%write_var (var_str ("mch1"), u)
	call model_vars%write_var (var_str ("wch1"), u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Model MSSM, values from SLHA file"
	write (u, "(A)")

	call global%model%write (u, verbose = .false., &
	show_vertices = .false., show_particles = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Selected global variables"
	write (u, "(A)")

	model_vars => global%model%get_var_list_ptr ()

	call model_vars%write_var (var_str ("mch1"), u)
	call model_vars%write_var (var_str ("wch1"), u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_slha_final ()
	call syntax_model_file_final ()
	call syntax_cmd_list_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_29"

	end subroutine commands_29

	@ %def commands_29
	@
	\subsubsection{Expressions for scales}
	Declare a scale, factorization scale or factorization scale expression.
	<<Commands: execute tests>>=
	call test (commands_30, "commands_30", &
	"scales", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_30
	<<Commands: tests>>=
	subroutine commands_30 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_30"
	write (u, "(A)") "* Purpose: define scales"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'scale = 200 GeV')
	call ifile_append (ifile, &
	'factorization_scale = eval Pt [particle]')
	call ifile_append (ifile, &
	'renormalization_scale = eval E [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_expr (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_30"

	end subroutine commands_30

	@ %def commands_30
	@
	\subsubsection{Weight and reweight expressions}
	Declare an expression for event weights and reweighting.
	<<Commands: execute tests>>=
	call test (commands_31, "commands_31", &
	"event weights/reweighting", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_31
	<<Commands: tests>>=
	subroutine commands_31 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_31"
	write (u, "(A)") "* Purpose: define weight/reweight"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'weight = eval Pz [particle]')
	call ifile_append (ifile, 'reweight = eval M2 [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_expr (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_31"

	end subroutine commands_31

	@ %def commands_31
	@
	\subsubsection{Selecting events}
	Declare an expression for selecting events in an analysis.
	<<Commands: execute tests>>=
	call test (commands_32, "commands_32", &
	"event selection", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_32
	<<Commands: tests>>=
	subroutine commands_32 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_32"
	write (u, "(A)") "* Purpose: define selection"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'selection = any PDG == 13 [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_expr (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_32"

	end subroutine commands_32

	@ %def commands_32
	@
	\subsubsection{Executing shell commands}
	Execute a shell command.
	<<Commands: execute tests>>=
	call test (commands_33, "commands_33", &
	"execute shell command", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_33
	<<Commands: tests>>=
	subroutine commands_33 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	integer :: u_file, iostat
	character(3) :: buffer

	write (u, "(A)") "* Test output: commands_33"
	write (u, "(A)") "* Purpose: execute shell command"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'exec ("echo foo >> bar")')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)
	u_file = free_unit ()
	open (u_file, file = "bar", &
	action = "read", status = "old")
	do
	read (u_file, "(A)", iostat = iostat) buffer
	if (iostat /= 0) exit
	end do
	write (u, "(A,A)") "should be 'foo': ", trim (buffer)
	close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_33"

	end subroutine commands_33

	@ %def commands_33
	@
	\subsubsection{Callback}
	Instead of an explicit write, use the callback feature to write the
	analysis file during event generation. We generate 4 events and
	arrange that the callback is executed while writing the 3rd event.
	<<Commands: execute tests>>=
	call test (commands_34, "commands_34", &
	"analysis via callback", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_34
	<<Commands: tests>>=
	subroutine commands_34 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib
	type(event_callback_34_t) :: event_callback

	write (u, "(A)") "* Test output: commands_34"
	write (u, "(A)") "* Purpose: write analysis data"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_int (var_str ("seed"), 0, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd34"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Prepare callback for writing analysis to I/O unit"
	write (u, "(A)")

	event_callback%u = u
	call global%set_event_callback (event_callback)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_34_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (commands_34_p)')
	call ifile_append (ifile, 'observable sq')
	call ifile_append (ifile, 'analysis = record sq (sqrts)')
	call ifile_append (ifile, 'n_events = 4')
	call ifile_append (ifile, 'event_callback_interval = 3')
	call ifile_append (ifile, 'simulate (commands_34_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_34"

	end subroutine commands_34

	@ %def commands_34
	@ For this test, we invent a callback object which simply writes the
	analysis file, using the standard call for this. Here we rely on the
	fact that the analysis data are stored as a global entity, otherwise
	we would have to access them via the event object.
	<<Commands: test auxiliary types>>=
	type, extends (event_callback_t) :: event_callback_34_t
	private
	integer :: u = 0
	contains
	procedure :: write => event_callback_34_write
	procedure :: proc => event_callback_34
	end type event_callback_34_t

	@ %def event_callback_t
	@ The output routine is unused. The actual callback should write the
	analysis data to the output unit that we have injected into the
	callback object.
	<<Commands: test auxiliary>>=
	subroutine event_callback_34_write (event_callback, unit)
	class(event_callback_34_t), intent(in) :: event_callback
	integer, intent(in), optional :: unit
	end subroutine event_callback_34_write

	subroutine event_callback_34 (event_callback, i, event)
	class(event_callback_34_t), intent(in) :: event_callback
	integer(i64), intent(in) :: i
	class(generic_event_t), intent(in) :: event
	call analysis_write (event_callback%u)
	end subroutine event_callback_34

	@ %def event_callback_34_write
	@ %def event_callback_34
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Toplevel module WHIZARD}
	<<[[whizard.f90]]>>=
	<<File header>>

	module whizard

	use io_units
	<<Use strings>>
	use os_interface
	use ifiles
	use lexers
	use parser
	use rt_data

	<<Standard module head>>

	<<WHIZARD: public>>

	<<WHIZARD: types>>

	<<WHIZARD: variables>>

	save

	interface
	<<WHIZARD: sub interfaces>>
	end interface

	end module whizard
	@ %def whizard
	@
	<<[[whizard_sub.f90]]>>=
	<<File header>>

	submodule (whizard) whizard_s

	use system_defs, only: VERSION_STRING
	use system_defs, only: EOF, BACKSLASH
	use diagnostics
	use eval_trees
	use models
	use phs_forests
	use prclib_stacks
	use slha_interface
	use commands

	implicit none

	contains

	<<WHIZARD: procedures>>

	end submodule whizard_s

	@ %def whizard_s
	@
	\subsection{Options}
	Here we introduce a wrapper that holds various user options, so they
	can transparently be passed from the main program to the [[whizard]]
	object. Most parameters are used for initializing the [[global]]
	state.
	<<WHIZARD: public>>=
	public :: whizard_options_t
	<<WHIZARD: types>>=
	type :: whizard_options_t
	type(string_t) :: job_id
	type(string_t), dimension(:), allocatable :: pack_args
	type(string_t), dimension(:), allocatable :: unpack_args
	type(string_t) :: preload_model
	type(string_t) :: default_lib
	type(string_t) :: preload_libraries
	logical :: rebuild_library = .false.
	logical :: recompile_library = .false.
	logical :: rebuild_phs = .false.
	logical :: rebuild_grids = .false.
	logical :: rebuild_events = .false.
	end type whizard_options_t

	@ %def whizard_options_t
	@
	\subsection{Parse tree stack}
	We collect all parse trees that we generate in the [[whizard]] object. To
	this end, we create a stack of parse trees. They must not be finalized before
	the [[global]] object is finalized, because items such as a cut definition may
	contain references to the parse tree from which they were generated.
	<<WHIZARD: types>>=
	type, extends (parse_tree_t) :: pt_entry_t
	type(pt_entry_t), pointer :: previous => null ()
	end type pt_entry_t

	@ %def pt_entry_t
	@ This is the stack. Since we always prepend, we just need the [[last]]
	pointer.
	<<WHIZARD: types>>=
	type :: pt_stack_t
	type(pt_entry_t), pointer :: last => null ()
	contains
	<<WHIZARD: pt stack: TBP>>
	end type pt_stack_t

	@ %def pt_stack_t
	@ The finalizer is called at the very end.
	<<WHIZARD: pt stack: TBP>>=
	procedure :: final => pt_stack_final
	<<WHIZARD: sub interfaces>>=
	module subroutine pt_stack_final (pt_stack)
	class(pt_stack_t), intent(inout) :: pt_stack
	end subroutine pt_stack_final
	<<WHIZARD: procedures>>=
	module subroutine pt_stack_final (pt_stack)
	class(pt_stack_t), intent(inout) :: pt_stack
	type(pt_entry_t), pointer :: current
	do while (associated (pt_stack%last))
	current => pt_stack%last
	pt_stack%last => current%previous
	call parse_tree_final (current%parse_tree_t)
	deallocate (current)
	end do
	end subroutine pt_stack_final

	@ %def pt_stack_final
	@ Create and push a new entry, keeping the previous ones.
	<<WHIZARD: pt stack: TBP>>=
	procedure :: push => pt_stack_push
	<<WHIZARD: sub interfaces>>=
	module subroutine pt_stack_push (pt_stack, parse_tree)
	class(pt_stack_t), intent(inout) :: pt_stack
	type(parse_tree_t), intent(out), pointer :: parse_tree
	end subroutine pt_stack_push
	<<WHIZARD: procedures>>=
	module subroutine pt_stack_push (pt_stack, parse_tree)
	class(pt_stack_t), intent(inout) :: pt_stack
	type(parse_tree_t), intent(out), pointer :: parse_tree
	type(pt_entry_t), pointer :: current
	allocate (current)
	parse_tree => current%parse_tree_t
	current%previous => pt_stack%last
	pt_stack%last => current
	end subroutine pt_stack_push

	@ %def pt_stack_push
	@
	\subsection{The [[whizard]] object}
	An object of type [[whizard_t]] is the top-level wrapper for a
	\whizard\ instance. The object holds various default
	settings and the current state of the generator, the [[global]] object
	of type [[rt_data_t]]. This object contains, for instance, the list
	of variables and the process libraries.

	Since components of the [[global]] subobject are frequently used as
	targets, the [[whizard]] object should also consistently carry the
	[[target]] attribute.

	The various self-tests do no not use this object. They initialize
	only specific subsets of the system, according to their needs.

	Note: we intend to allow several concurrent instances. In the current
	implementation, there are still a few obstacles to this: the model
	library and the syntax tables are global variables, and the error
	handling uses global state. This should be improved.
	<<WHIZARD: public>>=
	public :: whizard_t
	<<WHIZARD: types>>=
	type :: whizard_t
	type(whizard_options_t) :: options
	type(rt_data_t) :: global
	type(pt_stack_t) :: pt_stack
	contains
	<<WHIZARD: whizard: TBP>>
	end type whizard_t

	@ %def whizard_t
	@
	\subsection{Initialization and finalization}
	<<WHIZARD: whizard: TBP>>=
	procedure :: init => whizard_init
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_init (whizard, options, paths, logfile)
	class(whizard_t), intent(out), target :: whizard
	type(whizard_options_t), intent(in) :: options
	type(paths_t), intent(in), optional :: paths
	type(string_t), intent(in), optional :: logfile
	end subroutine whizard_init
	<<WHIZARD: procedures>>=
	module subroutine whizard_init (whizard, options, paths, logfile)
	class(whizard_t), intent(out), target :: whizard
	type(whizard_options_t), intent(in) :: options
	type(paths_t), intent(in), optional :: paths
	type(string_t), intent(in), optional :: logfile
	call init_syntax_tables ()
	whizard%options = options
	call whizard%global%global_init (paths, logfile)
	call whizard%init_job_id ()
	call whizard%init_rebuild_flags ()
	call whizard%unpack_files ()
	call whizard%preload_model ()
	call whizard%preload_library ()
	call whizard%global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
	end subroutine whizard_init

	@ %def whizard_init
	@ Apart from the global data which have been initialized above, the
	process and model lists need to be finalized.
	<<WHIZARD: whizard: TBP>>=
	procedure :: final => whizard_final
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_final (whizard)
	class(whizard_t), intent(inout), target :: whizard
	end subroutine whizard_final
	<<WHIZARD: procedures>>=
	module subroutine whizard_final (whizard)
	class(whizard_t), intent(inout), target :: whizard
	call whizard%global%final ()
	call whizard%pt_stack%final ()
	call whizard%pack_files ()
	call final_syntax_tables ()
	end subroutine whizard_final

	@ %def whizard_final
	@ Set the job ID, if nonempty. If the ID string is empty, the value remains
	undefined.
	<<WHIZARD: whizard: TBP>>=
	procedure :: init_job_id => whizard_init_job_id
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_init_job_id (whizard)
	class(whizard_t), intent(inout), target :: whizard
	end subroutine whizard_init_job_id
	<<WHIZARD: procedures>>=
	module subroutine whizard_init_job_id (whizard)
	class(whizard_t), intent(inout), target :: whizard
	associate (var_list => whizard%global%var_list, options => whizard%options)
	if (options%job_id /= "") then
	call var_list%set_string (var_str ("$job_id"), &
	options%job_id, is_known=.true.)
	end if
	end associate
	end subroutine whizard_init_job_id

	@ %def whizard_init_job_id
	@
	Set the rebuild flags. They can be specified on the command line and
	set the initial value for the associated logical variables.
	<<WHIZARD: whizard: TBP>>=
	procedure :: init_rebuild_flags => whizard_init_rebuild_flags
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_init_rebuild_flags (whizard)
	class(whizard_t), intent(inout), target :: whizard
	end subroutine whizard_init_rebuild_flags
	<<WHIZARD: procedures>>=
	module subroutine whizard_init_rebuild_flags (whizard)
	class(whizard_t), intent(inout), target :: whizard
	associate (var_list => whizard%global%var_list, options => whizard%options)
	call var_list%append_log (var_str ("?rebuild_library"), &
	options%rebuild_library, intrinsic=.true.)
	call var_list%append_log (var_str ("?recompile_library"), &
	options%recompile_library, intrinsic=.true.)
	call var_list%append_log (var_str ("?rebuild_phase_space"), &
	options%rebuild_phs, intrinsic=.true.)
	call var_list%append_log (var_str ("?rebuild_grids"), &
	options%rebuild_grids, intrinsic=.true.)
	call var_list%append_log (var_str ("?rebuild_events"), &
	options%rebuild_events, intrinsic=.true.)
	end associate
	end subroutine whizard_init_rebuild_flags

	@ %def whizard_init_rebuild_flags
	@
	Pack/unpack files in the working directory, if requested.
	<<WHIZARD: whizard: TBP>>=
	procedure :: pack_files => whizard_pack_files
	procedure :: unpack_files => whizard_unpack_files
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_pack_files (whizard)
	class(whizard_t), intent(in), target :: whizard
	end subroutine whizard_pack_files
	module subroutine whizard_unpack_files (whizard)
	class(whizard_t), intent(in), target :: whizard
	end subroutine whizard_unpack_files
	<<WHIZARD: procedures>>=
	module subroutine whizard_pack_files (whizard)
	class(whizard_t), intent(in), target :: whizard
	logical :: exist
	integer :: i
	type(string_t) :: file
	if (allocated (whizard%options%pack_args)) then
	do i = 1, size (whizard%options%pack_args)
	file = whizard%options%pack_args(i)
	call msg_message ("Packing file/dir '" // char (file) // "'")
	exist = os_file_exist (file) .or. os_dir_exist (file)
	if (exist) then
	call os_pack_file (whizard%options%pack_args(i), &
	whizard%global%os_data)
	else
	call msg_error ("File/dir '" // char (file) // "' not found")
	end if
	end do
	end if
	end subroutine whizard_pack_files

	module subroutine whizard_unpack_files (whizard)
	class(whizard_t), intent(in), target :: whizard
	logical :: exist
	integer :: i
	type(string_t) :: file
	if (allocated (whizard%options%unpack_args)) then
	do i = 1, size (whizard%options%unpack_args)
	file = whizard%options%unpack_args(i)
	call msg_message ("Unpacking file '" // char (file) // "'")
	exist = os_file_exist (file)
	if (exist) then
	call os_unpack_file (whizard%options%unpack_args(i), &
	whizard%global%os_data)
	else
	call msg_error ("File '" // char (file) // "' not found")
	end if
	end do
	end if
	end subroutine whizard_unpack_files

	@ %def whizard_pack_files
	@ %def whizard_unpack_files
	@
	This procedure preloads a model, if a model name is given.
	<<WHIZARD: whizard: TBP>>=
	procedure :: preload_model => whizard_preload_model
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_preload_model (whizard)
	class(whizard_t), intent(inout), target :: whizard
	end subroutine whizard_preload_model
	<<WHIZARD: procedures>>=
	module subroutine whizard_preload_model (whizard)
	class(whizard_t), intent(inout), target :: whizard
	type(string_t) :: model_name
	model_name = whizard%options%preload_model
	if (model_name /= "") then
	call whizard%global%read_model (model_name, whizard%global%preload_model)
	whizard%global%model => whizard%global%preload_model
	if (associated (whizard%global%model)) then
	call whizard%global%model%link_var_list (whizard%global%var_list)
	call whizard%global%var_list%set_string (var_str ("$model_name"), &
	model_name, is_known = .true.)
	call msg_message ("Preloaded model: " &
	// char (model_name))
	else
	call msg_fatal ("Preloading model " // char (model_name) &
	// " failed")
	end if
	else
	call msg_message ("No model preloaded")
	end if
	end subroutine whizard_preload_model

	@ %def whizard_preload_model
	@
	This procedure preloads a library, if a library name is given.

	Note: This version just opens a new library with that name. It does not load
	(yet) an existing library on file, as previous \whizard\ versions would do.
	<<WHIZARD: whizard: TBP>>=
	procedure :: preload_library => whizard_preload_library
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_preload_library (whizard)
	class(whizard_t), intent(inout), target :: whizard
	end subroutine whizard_preload_library
	<<WHIZARD: procedures>>=
	module subroutine whizard_preload_library (whizard)
	class(whizard_t), intent(inout), target :: whizard
	type(string_t) :: library_name, libs
	type(string_t), dimension(:), allocatable :: libname_static
	type(prclib_entry_t), pointer :: lib_entry
	integer :: i
	call get_prclib_static (libname_static)
	do i = 1, size (libname_static)
	allocate (lib_entry)
	call lib_entry%init_static (libname_static(i))
	call whizard%global%add_prclib (lib_entry)
	end do
	libs = adjustl (whizard%options%preload_libraries)
	if (libs == "" .and. whizard%options%default_lib /= "") then
	allocate (lib_entry)
	call lib_entry%init (whizard%options%default_lib)
	call whizard%global%add_prclib (lib_entry)
	call msg_message ("Preloaded library: " // &
	char (whizard%options%default_lib))
	end if
	SCAN_LIBS: do while (libs /= "")
	call split (libs, library_name, " ")
	if (library_name /= "") then
	allocate (lib_entry)
	call lib_entry%init (library_name)
	call whizard%global%add_prclib (lib_entry)
	call msg_message ("Preloaded library: " // char (library_name))
	end if
	end do SCAN_LIBS
	end subroutine whizard_preload_library

	@ %def whizard_preload_library
	@
	\subsection{Initialization and finalization: syntax tables}
	Initialize/finalize the syntax tables used by WHIZARD. These are effectively
	singleton objects. We introduce a module variable that tracks the
	initialization status.

	Without syntax tables, essentially nothing will work. Any initializer has to
	call this.
	<<WHIZARD: variables>>=
	logical :: syntax_tables_exist = .false.
	@ %def syntax_tables_exist
	@
	<<WHIZARD: public>>=
	public :: init_syntax_tables
	public :: final_syntax_tables
	<<WHIZARD: sub interfaces>>=
	module subroutine init_syntax_tables ()
	end subroutine init_syntax_tables
	module subroutine final_syntax_tables ()
	end subroutine final_syntax_tables
	<<WHIZARD: procedures>>=
	module subroutine init_syntax_tables ()
	if (.not. syntax_tables_exist) then
	call syntax_model_file_init ()
	call syntax_phs_forest_init ()
	call syntax_pexpr_init ()
	call syntax_slha_init ()
	call syntax_cmd_list_init ()
	syntax_tables_exist = .true.
	end if
	end subroutine init_syntax_tables

	module subroutine final_syntax_tables ()
	if (syntax_tables_exist) then
	call syntax_model_file_final ()
	call syntax_phs_forest_final ()
	call syntax_pexpr_final ()
	call syntax_slha_final ()
	call syntax_cmd_list_final ()
	syntax_tables_exist = .false.
	end if
	end subroutine final_syntax_tables

	@ %def init_syntax_tables
	@ %def final_syntax_tables
	@ Write the syntax tables to external files.
	<<WHIZARD: public>>=
	public :: write_syntax_tables
	<<WHIZARD: sub interfaces>>=
	module subroutine write_syntax_tables ()
	end subroutine write_syntax_tables
	<<WHIZARD: procedures>>=
	module subroutine write_syntax_tables ()
	integer :: unit
	character(*), parameter :: file_model = "whizard.model_file.syntax"
	character(*), parameter :: file_phs = "whizard.phase_space_file.syntax"
	character(*), parameter :: file_pexpr = "whizard.prt_expressions.syntax"
	character(*), parameter :: file_slha = "whizard.slha.syntax"
	character(*), parameter :: file_sindarin = "whizard.sindarin.syntax"
	if (.not. syntax_tables_exist) call init_syntax_tables ()
	unit = free_unit ()
	print *, "Writing file '" // file_model // "'"
	open (unit=unit, file=file_model, status="replace", action="write")
	write (unit, "(A)") VERSION_STRING
	write (unit, "(A)") "Syntax definition file: " // file_model
	call syntax_model_file_write (unit)
	close (unit)
	print *, "Writing file '" // file_phs // "'"
	open (unit=unit, file=file_phs, status="replace", action="write")
	write (unit, "(A)") VERSION_STRING
	write (unit, "(A)") "Syntax definition file: " // file_phs
	call syntax_phs_forest_write (unit)
	close (unit)
	print *, "Writing file '" // file_pexpr // "'"
	open (unit=unit, file=file_pexpr, status="replace", action="write")
	write (unit, "(A)") VERSION_STRING
	write (unit, "(A)") "Syntax definition file: " // file_pexpr
	call syntax_pexpr_write (unit)
	close (unit)
	print *, "Writing file '" // file_slha // "'"
	open (unit=unit, file=file_slha, status="replace", action="write")
	write (unit, "(A)") VERSION_STRING
	write (unit, "(A)") "Syntax definition file: " // file_slha
	call syntax_slha_write (unit)
	close (unit)
	print *, "Writing file '" // file_sindarin // "'"
	open (unit=unit, file=file_sindarin, status="replace", action="write")
	write (unit, "(A)") VERSION_STRING
	write (unit, "(A)") "Syntax definition file: " // file_sindarin
	call syntax_cmd_list_write (unit)
	close (unit)
	end subroutine write_syntax_tables

	@ %def write_syntax_tables
	@
	\subsection{Execute command lists}
	Process commands given on the command line, stored as an [[ifile]]. The whole
	input is read, compiled and executed as a whole.
	<<WHIZARD: whizard: TBP>>=
	procedure :: process_ifile => whizard_process_ifile
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_process_ifile (whizard, ifile, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	type(ifile_t), intent(in) :: ifile
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	end subroutine whizard_process_ifile
	<<WHIZARD: procedures>>=
	module subroutine whizard_process_ifile (whizard, ifile, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	type(ifile_t), intent(in) :: ifile
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	type(lexer_t), target :: lexer
	type(stream_t), target :: stream
	call msg_message ("Reading commands given on the command line")
	call lexer_init_cmd_list (lexer)
	call stream_init (stream, ifile)
	call whizard%process_stream (stream, lexer, quit, quit_code)
	call stream_final (stream)
	call lexer_final (lexer)
	end subroutine whizard_process_ifile

	@ %def whizard_process_ifile
	@ Process standard input as a command list. The whole input is read,
	compiled and executed as a whole.
	<<WHIZARD: whizard: TBP>>=
	procedure :: process_stdin => whizard_process_stdin
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_process_stdin (whizard, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	end subroutine whizard_process_stdin
	<<WHIZARD: procedures>>=
	module subroutine whizard_process_stdin (whizard, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	type(lexer_t), target :: lexer
	type(stream_t), target :: stream
	call msg_message ("Reading commands from standard input")
	call lexer_init_cmd_list (lexer)
	call stream_init (stream, 5)
	call whizard%process_stream (stream, lexer, quit, quit_code)
	call stream_final (stream)
	call lexer_final (lexer)
	end subroutine whizard_process_stdin

	@ %def whizard_process_stdin
	@ Process a file as a command list.
	<<WHIZARD: whizard: TBP>>=
	procedure :: process_file => whizard_process_file
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_process_file (whizard, file, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	type(string_t), intent(in) :: file
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	end subroutine whizard_process_file
	<<WHIZARD: procedures>>=
	module subroutine whizard_process_file (whizard, file, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	type(string_t), intent(in) :: file
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	type(lexer_t), target :: lexer
	type(stream_t), target :: stream
	logical :: exist
	call msg_message ("Reading commands from file '" // char (file) // "'")
	inquire (file=char(file), exist=exist)
	if (exist) then
	call lexer_init_cmd_list (lexer)
	call stream_init (stream, char (file))
	call whizard%process_stream (stream, lexer, quit, quit_code)
	call stream_final (stream)
	call lexer_final (lexer)
	else
	call msg_error ("File '" // char (file) // "' not found")
	end if
	end subroutine whizard_process_file

	@ %def whizard_process_file
	@
	<<WHIZARD: whizard: TBP>>=
	procedure :: process_stream => whizard_process_stream
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_process_stream &
	(whizard, stream, lexer, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	type(stream_t), intent(inout), target :: stream
	type(lexer_t), intent(inout), target :: lexer
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	end subroutine whizard_process_stream
	<<WHIZARD: procedures>>=
	module subroutine whizard_process_stream &
	(whizard, stream, lexer, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	type(stream_t), intent(inout), target :: stream
	type(lexer_t), intent(inout), target :: lexer
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	type(parse_tree_t), pointer :: parse_tree
	type(command_list_t), target :: command_list
	call lexer_assign_stream (lexer, stream)
	call whizard%pt_stack%push (parse_tree)
	call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
	if (associated (parse_tree%get_root_ptr ())) then
	whizard%global%lexer => lexer
	call command_list%compile (parse_tree%get_root_ptr (), &
	whizard%global)
	end if
	call whizard%global%activate ()
	call command_list%execute (whizard%global)
	call command_list%final ()
	quit = whizard%global%quit
	quit_code = whizard%global%quit_code
	end subroutine whizard_process_stream

	@ %def whizard_process_stream
	@
	\subsection{The WHIZARD shell}
	This procedure implements interactive mode. One line is processed at
	a time.
	<<WHIZARD: whizard: TBP>>=
	procedure :: shell => whizard_shell
	<<WHIZARD: sub interfaces>>=
	module subroutine whizard_shell (whizard, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	integer, intent(out) :: quit_code
	end subroutine whizard_shell
	<<WHIZARD: procedures>>=
	module subroutine whizard_shell (whizard, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	integer, intent(out) :: quit_code
	type(lexer_t), target :: lexer
	type(stream_t), target :: stream
	type(string_t) :: prompt1
	type(string_t) :: prompt2
	type(string_t) :: input
	type(string_t) :: extra
	integer :: last
	integer :: iostat
	logical :: mask_tmp
	logical :: quit
	call msg_message ("Launching interactive shell")
	call lexer_init_cmd_list (lexer)
	prompt1 = "whish? "
	prompt2 = " > "
	COMMAND_LOOP: do
	call put (6, prompt1)
	call get (5, input, iostat=iostat)
	if (iostat > 0 .or. iostat == EOF) exit COMMAND_LOOP
	CONTINUE_INPUT: do
	last = len_trim (input)
	if (extract (input, last, last) /= BACKSLASH) exit CONTINUE_INPUT
	call put (6, prompt2)
	call get (5, extra, iostat=iostat)
	if (iostat > 0) exit COMMAND_LOOP
	input = replace (input, last, extra)
	end do CONTINUE_INPUT
	call stream_init (stream, input)
	mask_tmp = mask_fatal_errors
	mask_fatal_errors = .true.
	call whizard%process_stream (stream, lexer, quit, quit_code)
	msg_count = 0
	mask_fatal_errors = mask_tmp
	call stream_final (stream)
	if (quit) exit COMMAND_LOOP
	end do COMMAND_LOOP
	print *
	call lexer_final (lexer)
	end subroutine whizard_shell

	@ %def whizard_shell
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Query Feature Support}
	This module accesses the various optional features (modules) that
	WHIZARD can support and repors on their availability.
	<<[[features.f90]]>>=
	module features

	<<Standard module head>>

	<<Features: public>>

	interface
	<<Features: sub interfaces>>
	end interface

	end module features
	@ %def features
	@
	<<[[features_sub.f90]]>>=
	<<File header>>

	submodule (features) features_s

	use string_utils, only: lower_case
	use system_dependencies, only: WHIZARD_VERSION
	<<Features: dependencies>>

	implicit none

	contains

	<<Features: procedures>>

	end submodule features_s

	@ %def features_s
	@
	\subsection{Output}
	<<Features: public>>=
	public :: print_features
	<<Features: sub interfaces>>=
	module subroutine print_features ()
	end subroutine print_features
	<<Features: procedures>>=
	module subroutine print_features ()
	print "(A)", "WHIZARD " // WHIZARD_VERSION
	print "(A)", "Build configuration:"
	<<Features: config>>
	print "(A)", "Optional features available in this build:"
	<<Features: print>>
	end subroutine print_features

	@ %def print_features
	@
	\subsection{Query function}
	<<Features: procedures>>=
	subroutine check (feature, recognized, result, help)
	character(*), intent(in) :: feature
	logical, intent(out) :: recognized
	character(*), intent(out) :: result, help
	recognized = .true.
	result = "no"
	select case (lower_case (trim (feature)))
	<<Features: cases>>
	case default
	recognized = .false.
	end select
	end subroutine check

	@ %def check
	@ Print this result:
	<<Features: procedures>>=
	subroutine print_check (feature)
	character(*), intent(in) :: feature
	character(16) :: f
	logical :: recognized
	character(10) :: result
	character(48) :: help
	call check (feature, recognized, result, help)
	if (.not. recognized) then
	result = "unknown"
	help = ""
	end if
	f = feature
	print "(2x,A,1x,A,'(',A,')')", f, result, trim (help)
	end subroutine print_check

	@ %def print_check
	@
	\subsection{Basic configuration}
	<<Features: config>>=
	call print_check ("precision")
	<<Features: dependencies>>=
	use kinds, only: default
	<<Features: cases>>=
	case ("precision")
	write (result, "(I0)") precision (1._default)
	help = "significant decimals of real/complex numbers"
	@
	\subsection{Optional features case by case}
	<<Features: print>>=
	call print_check ("OpenMP")
	<<Features: dependencies>>=
	use system_dependencies, only: openmp_is_active
	<<Features: cases>>=
	case ("openmp")
	if (openmp_is_active ()) then
	result = "yes"
	end if
	help = "OpenMP parallel execution"
	@
	<<Features: print>>=
	call print_check ("GoSam")
	<<Features: dependencies>>=
	use system_dependencies, only: GOSAM_AVAILABLE
	<<Features: cases>>=
	case ("gosam")
	if (GOSAM_AVAILABLE) then
	result = "yes"
	end if
	help = "external NLO matrix element provider"
	@
	<<Features: print>>=
	call print_check ("OpenLoops")
	<<Features: dependencies>>=
	use system_dependencies, only: OPENLOOPS_AVAILABLE
	<<Features: cases>>=
	case ("openloops")
	if (OPENLOOPS_AVAILABLE) then
	result = "yes"
	end if
	help = "external NLO matrix element provider"
	@
	<<Features: print>>=
	call print_check ("Recola")
	<<Features: dependencies>>=
	use system_dependencies, only: RECOLA_AVAILABLE
	<<Features: cases>>=
	case ("recola")
	if (RECOLA_AVAILABLE) then
	result = "yes"
	end if
	help = "external NLO matrix element provider"
	@
	<<Features: print>>=
	call print_check ("LHAPDF")
	<<Features: dependencies>>=
	use system_dependencies, only: LHAPDF5_AVAILABLE
	use system_dependencies, only: LHAPDF6_AVAILABLE
	<<Features: cases>>=
	case ("lhapdf")
	if (LHAPDF5_AVAILABLE) then
	result = "v5"
	else if (LHAPDF6_AVAILABLE) then
	result = "v6"
	end if
	help = "PDF library"
	@
	<<Features: print>>=
	call print_check ("HOPPET")
	<<Features: dependencies>>=
	use system_dependencies, only: HOPPET_AVAILABLE
	<<Features: cases>>=
	case ("hoppet")
	if (HOPPET_AVAILABLE) then
	result = "yes"
	end if
	help = "PDF evolution package"
	@
	<<Features: print>>=
	call print_check ("fastjet")
	<<Features: dependencies>>=
	use jets, only: fastjet_available
	<<Features: cases>>=
	case ("fastjet")
	if (fastjet_available ()) then
	result = "yes"
	end if
	help = "jet-clustering package"
	@
	<<Features: print>>=
	call print_check ("Pythia6")
	<<Features: dependencies>>=
	use system_dependencies, only: PYTHIA6_AVAILABLE
	<<Features: cases>>=
	case ("pythia6")
	if (PYTHIA6_AVAILABLE) then
	result = "yes"
	end if
	help = "direct access for shower/hadronization"
	@
	<<Features: print>>=
	call print_check ("Pythia8")
	<<Features: dependencies>>=
	use system_dependencies, only: PYTHIA8_AVAILABLE
	<<Features: cases>>=
	case ("pythia8")
	if (PYTHIA8_AVAILABLE) then
	result = "yes"
	end if
	help = "direct access for shower/hadronization"
	@
	<<Features: print>>=
	call print_check ("StdHEP")
	<<Features: cases>>=
	case ("stdhep")
	result = "yes"
	help = "event I/O format"
	@
	<<Features: print>>=
	call print_check ("HepMC")
	<<Features: dependencies>>=
	use hepmc_interface, only: hepmc_is_available
	<<Features: cases>>=
	case ("hepmc")
	if (hepmc_is_available ()) then
	result = "yes"
	end if
	help = "event I/O format"
	@
	<<Features: print>>=
	call print_check ("LCIO")
	<<Features: dependencies>>=
	use lcio_interface, only: lcio_is_available
	<<Features: cases>>=
	case ("lcio")
	if (lcio_is_available ()) then
	result = "yes"
	end if
	help = "event I/O format"
	@
	<<Features: print>>=
	call print_check ("MetaPost")
	<<Features: dependencies>>=
	use system_dependencies, only: EVENT_ANALYSIS
	<<Features: cases>>=
	case ("metapost")
	result = EVENT_ANALYSIS
	help = "graphical event analysis via LaTeX/MetaPost"
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	Index: trunk/src/recola/recola.nw
	===================================================================
	--- trunk/src/recola/recola.nw (revision 8903)
	+++ trunk/src/recola/recola.nw (revision 8904)
	@@ -1,3543 +1,3545 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: interface to Recola 1-loop library

	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Recola Interface}
	\section{Recola wrapper}
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	<<[[recola_wrapper.f90]]>>=
	<<File header>>

	module recola_wrapper

	use recola !NODEP!

	use kinds
	<<Use strings>>
	<<Use debug>>
	use constants, only: zero
	use diagnostics, only: msg_fatal, msg_message, msg_debug, msg_debug2, D_ME_METHODS
	use io_units, only: given_output_unit

	<<Standard module head>>

	<<Recola wrapper: public>>

	<<Recola wrapper: parameters>>

	<<Recola wrapper: types>>

	<<Recola wrapper: variables>>

	contains

	<<Recola wrapper: procedures>>

	end module recola_wrapper
	@ %def recola_wrapper
	@
	<<Recola wrapper: parameters>>=
	public :: rclwrap_is_active
	<<Recola wrapper: parameters>>=
	logical, parameter :: rclwrap_is_active = .true.

	@ %def rclwrap_is_active
	@ Returns the particle string corresponding to a pdg code used in the Recola
	process definition
	<<Recola wrapper: public>>=
	public :: get_recola_particle_string
	<<Recola wrapper: procedures>>=
	elemental function get_recola_particle_string (pdg) result (name)
	type(string_t) :: name
	integer, intent(in) :: pdg
	select case (pdg)
	case (1)
	name = var_str ("d")
	case (-1)
	name = var_str ("d~")
	case (2)
	name = var_str ("u")
	case (-2)
	name = var_str ("u~")
	case (3)
	name = var_str ("s")
	case (-3)
	name = var_str ("s~")
	case (4)
	name = var_str ("c")
	case (-4)
	name = var_str ("c~")
	case (5)
	name = var_str ("b")
	case (-5)
	name = var_str ("b~")
	case (6)
	name = var_str ("t")
	case (-6)
	name = var_str ("t~")
	case (11)
	name = var_str ("e-")
	case (-11)
	name = var_str ("e+")
	case (12)
	name = var_str ("nu_e")
	case (-12)
	name = var_str ("nu_e~")
	case (13)
	name = var_str ("mu-")
	case (-13)
	name = var_str ("mu+")
	case (14)
	name = var_str ("nu_mu")
	case (-14)
	name = var_str ("nu_mu~")
	case (15)
	name = var_str ("tau-")
	case (-15)
	name = var_str ("tau+")
	case (16)
	name = var_str ("nu_tau")
	case (-16)
	name = var_str ("nu_tau~")
	case (21)
	name = var_str ("g")
	case (22)
	name = var_str ("A")
	case (23)
	name = var_str ("Z")
	case (24)
	name = var_str ("W+")
	case (-24)
	name = var_str ("W-")
	case (25)
	name = var_str ("H")
	end select
	end function get_recola_particle_string

	@ %def get_recola_particle_string
	@
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_define_process (id, process_string, order)
	integer, intent(in) :: id
	type(string_t), intent(in) :: process_string
	type(string_t), intent(in) :: order
	if (debug_on) call msg_debug2 (D_ME_METHODS, "define_process_rcl")
	call define_process_rcl (id, char (process_string), char (order))
	end subroutine rclwrap_define_process

	@ %def rclwrap_define_process
	@ This defines a wrapper for the information required to define a RECOLA
	process. It is used to collect the process definitions in an array.
	<<Recola wrapper: types>>=
	type :: rcl_process_t
	private
	integer :: id
	type(string_t) :: process_string
	type(string_t) :: order
	contains
	<<Recola wrapper: rcl process: TBP>>
	end type rcl_process_t

	@ %def rcl_process_t
	@
	<<Recola wrapper: types>>=
	interface rcl_process_t
	module procedure new_rcl_process_t
	end interface

	@ %def rcl_process_t
	@
	<<Recola wrapper: procedures>>=
	function new_rcl_process_t (id, process_string, order)
	integer, intent(in) :: id
	type(string_t), intent(in) :: process_string, order
	type(rcl_process_t) :: new_rcl_process_t
	new_rcl_process_t%id = id
	new_rcl_process_t%process_string = process_string
	new_rcl_process_t%order = order
	end function new_rcl_process_t

	@ %def new_rcl_process_t
	<<Recola wrapper: rcl process: TBP>>=
	procedure :: get_params => rcl_process_get_params
	<<Recola wrapper: procedures>>=
	subroutine rcl_process_get_params (prc, id, process_string, order)
	class(rcl_process_t), intent(in) :: prc
	integer, intent(out) :: id
	type(string_t), intent(out) :: process_string
	type(string_t), intent(out) :: order
	id = prc%id
	process_string = prc%process_string
	order = prc%order
	end subroutine rcl_process_get_params

	@ %def rcl_process_get_params
	@ Output.
	<<Recola wrapper: rcl process: TBP>>=
	procedure :: write => rcl_process_write
	<<Recola wrapper: procedures>>=
	subroutine rcl_process_write (object, unit)
	class(rcl_process_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A,I0,2(1x,A,1x))") "RECOLA process:", &
	"id=", object%id, "process_string=", char(object%process_string), &
	"order=", char(object%order)
	end subroutine rcl_process_write

	@ %def rcl_process_write
	@ This defines a singleton object, located in this module only, that
	controls RECOLA initialization and process management. When WHIZARD
	compiles processes, it should also run the RECOLA "`controller"',
	which actually initializes RECOLA for integration and manages process
	information in an array. The main complication is that this has to be
	done after all processes have been registered, and cannot be redone.

	We could work with module variables directly, but the singleton
	pattern, e.g., allows us to work with multiple RECOLA instances, if this
	becomes possible in the future.

	Type and object can be private.
	<<Recola wrapper: types>>=
	type :: rcl_controller_t
	private
	logical :: active = .false.
	logical :: defined = .false.
	logical :: done = .false.
	integer :: recola_id = 0
	type(rcl_process_t), dimension (:), allocatable :: processes
	integer :: n_processes = 0
	contains
	<<Recola wrapper: rcl controller: TBP>>
	end type rcl_controller_t

	@ %def rcl_controller_t
	<<Recola wrapper: variables>>=
	type(rcl_controller_t), target, save :: rcl_controller

	@ %def rcl_controller
	@ Add a RECOLA process to the controller. This will make sure that
	processes can be redefined if additional definitions are to be made
	after process generation.
	<<Recola wrapper: rcl controller: TBP>>=
	procedure :: add_process => rcl_controller_add_process
	<<Recola wrapper: procedures>>=
	subroutine rcl_controller_add_process (rcl, process)
	class(rcl_controller_t), intent(inout) :: rcl
	type(rcl_process_t), intent(in) :: process
	type(rcl_process_t), dimension (:), allocatable :: temp
	if (rcl%n_processes == size(rcl%processes)) then
	allocate( temp(2 * rcl%n_processes) )
	temp(:rcl%n_processes) = rcl%processes
	call move_alloc(temp, rcl%processes)
	end if
	rcl%processes(rcl%n_processes + 1) = process
	rcl%n_processes = rcl%n_processes + 1
	end subroutine rcl_controller_add_process

	@ %def rcl_controller_add_process
	@ Define all processes added to the controller, and only them.
	If processes have been defined before, RECOLA is reset.
	<<Recola wrapper: rcl controller: TBP>>=
	procedure :: define_processes => rcl_controller_define_processes
	<<Recola wrapper: procedures>>=
	subroutine rcl_controller_define_processes (rcl)
	class(rcl_controller_t), intent(inout) :: rcl
	integer :: id, i
	type(string_t) :: process_string
	type(string_t) :: order
	if (rcl%defined) then
	if (.not. rcl%done) call rclwrap_generate_processes ()
	if (debug_on) call msg_debug2 (D_ME_METHODS, "reset_recola_rcl")
	call reset_recola_rcl ()
	end if
	do i = 1, rcl%n_processes
	call rcl%processes(i)%get_params(id, process_string, order)
	call rclwrap_define_process (id, process_string, order)
	end do
	rcl%defined = .true.
	rcl%done = .false.
	end subroutine rcl_controller_define_processes

	@ %def rcl_controller_define_processes
	@ Revert to initial state. Also, reset RECOLA (only if it has already
	done something).
	<<Recola wrapper: rcl controller: TBP>>=
	procedure :: reset => rcl_controller_reset
	<<Recola wrapper: procedures>>=
	subroutine rcl_controller_reset (rcl)
	class(rcl_controller_t), intent(inout) :: rcl
	if (rcl%active .or. rcl%done) then
	if (debug_on) call msg_debug2 (D_ME_METHODS, "reset_recola_rcl")
	if (allocated (rcl%processes)) deallocate (rcl%processes)
	call reset_recola_rcl ()
	end if
	rcl%active = .false.
	rcl%defined = .false.
	rcl%done = .false.
	rcl%recola_id = 0
	rcl%n_processes = 0
	end subroutine rcl_controller_reset

	@ %def rcl_controller_reset
	@ Output.
	<<Recola wrapper: rcl controller: TBP>>=
	procedure :: write => rcl_controller_write
	<<Recola wrapper: procedures>>=
	subroutine rcl_controller_write (object, unit)
	class(rcl_controller_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A,2(1x,A,L1),2(1x,A,I0))") "RECOLA controller:", &
	"active=", object%active, "done=", object%done, &
	"id=", object%recola_id, "n_processes=", object%n_processes
	end subroutine rcl_controller_write

	@ %def rcl_controller_write
	@ Return a new numeric process ID, incrementing the counter once.
	<<Recola wrapper: rcl controller: TBP>>=
	procedure :: get_new_id => rcl_controller_get_new_id
	<<Recola wrapper: procedures>>=
	subroutine rcl_controller_get_new_id (object, id)
	class(rcl_controller_t), intent(inout) :: object
	integer, intent(out) :: id
	object%recola_id = object%recola_id + 1
	id = object%recola_id
	end subroutine rcl_controller_get_new_id

	@ %def rcl_controller_get_new_id
	@ Return the current numeric process ID without incrementing the counter.
	<<Recola wrapper: rcl controller: TBP>>=
	procedure :: get_current_id => rcl_controller_get_current_id
	<<Recola wrapper: procedures>>=
	subroutine rcl_controller_get_current_id (object, id)
	class(rcl_controller_t), intent(inout) :: object
	integer, intent(out) :: id
	id = object%recola_id
	end subroutine rcl_controller_get_current_id

	@ %def rcl_controller_get_current_id
	@ Do not allow activation if processes have been calculated
	previously. Otherwise set the flag.
	<<Recola wrapper: rcl controller: TBP>>=
	procedure :: activate => rcl_controller_activate
	<<Recola wrapper: procedures>>=
	subroutine rcl_controller_activate (rcl)
	class(rcl_controller_t), intent(inout) :: rcl
	if ( .not. allocated(rcl%processes) ) allocate ( rcl%processes(10) )
	rcl_controller%active = .true.
	end subroutine rcl_controller_activate

	@ %def rcl_controller_activate
	@ Start process initialization by calling the RECOLA API. Do not
	allow this twice (skip silently), and skip anyway if there is no activation.
	<<Recola wrapper: rcl controller: TBP>>=
	procedure :: generate_processes => rcl_controller_generate_processes
	<<Recola wrapper: procedures>>=
	subroutine rcl_controller_generate_processes (rcl)
	class(rcl_controller_t), intent(inout) :: rcl
	if (rcl_controller%active) then
	if (.not. rcl_controller%done) then
	call msg_message ("Recola: preparing processes for integration")
	call generate_processes_rcl ()
	rcl_controller%done = .true.
	end if
	end if
	end subroutine rcl_controller_generate_processes

	@ %def rcl_controller_generate_processes
	@ Return a new numeric RECOLA process ID. The singleton nature of the
	controller guarantees that the ID is unique.
	<<Recola wrapper: public>>=
	public :: rclwrap_get_new_recola_id
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_new_recola_id (id)
	integer, intent(out) :: id
	call rcl_controller%get_new_id (id)
	end subroutine rclwrap_get_new_recola_id

	@ %def rclwrap_get_new_recola_id
	@ Return the current numeric RECOLA process ID. This coincides with the amount
	of IDs currently in use.
	<<Recola wrapper: public>>=
	public :: rclwrap_get_current_recola_id
	<<Recola wrapper: procedures>>=
	function rclwrap_get_current_recola_id () result (n)
	integer :: n
	call rcl_controller%get_current_id (n)
	end function rclwrap_get_current_recola_id

	@ %def rclwrap_get_current_recola_id
	@ This procedure records the fact that there is a recola process
	pending, so we will have to call [[generate_processes]] before we can
	calculate anything with Recola.
	<<Recola wrapper: public>>=
	public :: rclwrap_request_generate_processes
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_request_generate_processes ()
	if (debug_on) call msg_debug2 (D_ME_METHODS, "request_generate_processes_rcl")
	call rcl_controller%activate ()
	end subroutine rclwrap_request_generate_processes

	@ %def rclwrap_request_generate_processes
	@ Add a process to be defined later
	<<Recola wrapper: public>>=
	public :: rclwrap_add_process
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_add_process (id, process_string, order)
	integer, intent(in) :: id
	type(string_t), intent(in) :: process_string, order
	type(rcl_process_t) :: prc
	if (debug_on) call msg_debug2 (D_ME_METHODS, "add_process_rcl: id", id)
	prc = rcl_process_t (id, process_string, order)
	call rcl_controller%add_process (prc)
	end subroutine rclwrap_add_process

	@ %def rclwrap_add_process
	@ Define all added processes. Reset if processes were already defined.
	<<Recola wrapper: public>>=
	public :: rclwrap_define_processes
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_define_processes ()
	if (debug_on) call msg_debug2 (D_ME_METHODS, "define_processes_rcl")
	call rcl_controller%define_processes ()
	end subroutine rclwrap_define_processes

	@ %def rclwrap_define_processes
	@ We call this after all processes have been added and defined,
	so RECOLA can initialize itself for integration.
	<<Recola wrapper: public>>=
	public :: rclwrap_generate_processes
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_generate_processes ()
	if (debug_on) call msg_debug2 (D_ME_METHODS, "generate_processes_rcl")
	call rcl_controller%generate_processes ()
	end subroutine rclwrap_generate_processes

	@ %def rclwrap_generate_processes
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_compute_process
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_compute_process (id, p, order, sqme)
	integer, intent(in) :: id
	real(double), intent(in), dimension(:,:) :: p
	character(len=*), intent(in) :: order
	real(double), intent(out), dimension(0:1), optional :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "compute_process_rcl")
	call compute_process_rcl (id, p, order, sqme)
	end subroutine rclwrap_compute_process

	@ %def rclwrap_compute_process
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_amplitude
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_amplitude (id, g_power, order, col, hel, amp)
	integer, intent(in) :: id, g_power
	character(len=*), intent(in) :: order
	integer, dimension(:), intent(in) :: col, hel
	complex(double), intent(out) :: amp
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_amplitude_rcl")
	call get_amplitude_rcl (id, g_power, order, col, hel, amp)
	end subroutine rclwrap_get_amplitude

	@ %def rclwrap_get_amplitude
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_squared_amplitude
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_squared_amplitude (id, alphas_power, order, sqme)
	integer, intent(in) :: id, alphas_power
	character(len=*), intent(in) :: order
	real(double), intent(out) :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_squared_amplitude_rcl")
	call get_squared_amplitude_rcl (id, alphas_power, order, sqme)
	end subroutine rclwrap_get_squared_amplitude

	@ %def rclwrap_get_squared_amplitude
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_pole_mass
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_pole_mass (pdg_id, mass, width)
	integer, intent(in) :: pdg_id
	real(double), intent(in) :: mass, width
	if (debug_on) call msg_debug2 (D_ME_METHODS, "rclwrap_set_pole_mass of ", pdg_id)
	select case (abs(pdg_id))
	case (11)
	if (width > zero) &
	call msg_fatal ("Recola pole mass: Attempting to set non-zero electron width!")
	call set_pole_mass_electron_rcl (mass)
	case (13)
	call set_pole_mass_muon_rcl (mass, width)
	case (15)
	call set_pole_mass_tau_rcl (mass, width)
	case (1)
	if (width > zero) &
	call msg_fatal ("Recola pole mass: Attempting to set non-zero down-quark width!")
	call set_pole_mass_down_rcl (mass)
	case (2)
	if (width > zero) &
	call msg_fatal ("Recola pole mass: Attempting to set non-zero up-quark width!")
	call set_pole_mass_up_rcl (mass)
	case (3)
	if (width > zero) &
	call msg_fatal ("Recola pole mass: Attempting to set non-zero strange-quark width!")
	call set_pole_mass_strange_rcl (mass)
	case (4)
	call set_pole_mass_charm_rcl (mass, width)
	case (5)
	call set_pole_mass_bottom_rcl (mass, width)
	case (6)
	call set_pole_mass_top_rcl (mass, width)
	case (23)
	call set_pole_mass_z_rcl (mass, width)
	case (24)
	call set_pole_mass_w_rcl (mass, width)
	case (25)
	call set_pole_mass_h_rcl (mass, width)
	case default
	call msg_fatal ("Recola pole mass: Unsupported particle")
	end select
	end subroutine rclwrap_set_pole_mass

	@ %def rclwrap_set_pole_mass
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_onshell_mass
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_onshell_mass (pdg_id, mass, width)
	integer, intent(in) :: pdg_id
	real(double), intent(in) :: mass, width
	if (debug_on) call msg_debug2 (D_ME_METHODS, "rclwrap_set_onshell_mass of ", pdg_id)
	select case (abs(pdg_id))
	case (23)
	call set_onshell_mass_z_rcl (mass, width)
	case (24)
	call set_onshell_mass_w_rcl (mass, width)
	case default
	call msg_fatal ("Recola onshell mass: Only for W and Z")
	end select
	end subroutine rclwrap_set_onshell_mass

	@ %def rclwrap_set_onshell_mass
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_use_gfermi_scheme
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_use_gfermi_scheme (gf)
	real(double), intent(in), optional :: gf
	if (debug_on) call msg_debug2 (D_ME_METHODS, "use_gfermi_scheme_rcl", &
	real(gf, kind=default))
	call use_gfermi_scheme_rcl (gf)
	end subroutine rclwrap_use_gfermi_scheme

	@ %def rclwrap_use_gfermi_scheme
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_light_fermions
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_light_fermions (m)
	real(double), intent(in) :: m
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_light_fermions_rcl", &
	real(m, kind=default))
	call set_light_fermions_rcl (m)
	end subroutine rclwrap_set_light_fermions

	@ %def rclwrap_set_light_fermions
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_light_fermion
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_light_fermion (pdg_id)
	integer, intent(in) :: pdg_id
	if (debug_on) call msg_debug2 (D_ME_METHODS, "rclwrap_set_light_fermion", pdg_id)
	select case (abs(pdg_id))
	case (1)
	call set_light_down_rcl ()
	case (2)
	call set_light_up_rcl ()
	case (3)
	call set_light_strange_rcl ()
	case (4)
	call set_light_charm_rcl ()
	case (5)
	call set_light_bottom_rcl ()
	case (6)
	call set_light_top_rcl ()
	case (11)
	call set_light_electron_rcl ()
	case (13)
	call set_light_muon_rcl ()
	case (15)
	call set_light_tau_rcl ()
	end select
	end subroutine rclwrap_set_light_fermion

	@ %def rclwrap_set_light_fermion
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_unset_light_fermion
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_unset_light_fermion (pdg_id)
	integer, intent(in) :: pdg_id
	if (debug_on) call msg_debug2 (D_ME_METHODS, "rclwrap_unset_light_fermion", pdg_id)
	select case (abs(pdg_id))
	case (1)
	call unset_light_down_rcl ()
	case (2)
	call unset_light_up_rcl ()
	case (3)
	call unset_light_strange_rcl ()
	case (4)
	call unset_light_charm_rcl ()
	case (5)
	call unset_light_bottom_rcl ()
	case (6)
	call unset_light_top_rcl ()
	case (11)
	call unset_light_electron_rcl ()
	case (13)
	call unset_light_muon_rcl ()
	case (15)
	call unset_light_tau_rcl ()
	end select
	end subroutine rclwrap_unset_light_fermion

	@ %def rclwrap_unset_light_fermion
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_onshell_scheme
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_onshell_scheme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_on_shell_scheme_rcl")
	call set_on_shell_scheme_rcl ()
	end subroutine rclwrap_set_onshell_scheme

	@ %def rclwrap_set_onshell_scheme
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_alpha_s
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_alpha_s (alpha_s, mu, nf)
	real(double), intent(in) :: alpha_s, mu
	integer, intent(in) :: nf
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_alphas_rcl")
	call set_alphas_rcl (alpha_s, mu, nf)
	end subroutine rclwrap_set_alpha_s

	@ %def rclwrap_set_alpha_s
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_alpha_s
	<<Recola wrapper: procedures>>=
	function rclwrap_get_alpha_s () result (alpha_s)
	real(double) :: alpha_s
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_alphas_rcl")
	call get_alphas_rcl (alpha_s)
	end function rclwrap_get_alpha_s

	@ %def rclwrap_get_alpha_s
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_alpha
	<<Recola wrapper: procedures>>=
	function rclwrap_get_alpha () result (alpha)
	real(double) :: alpha
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_alpha_rcl")
	call get_alpha_rcl (alpha)
	end function rclwrap_get_alpha

	@ %def rclwrap_get_alpha
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_helicity_configurations
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_helicity_configurations (id, hel)
	integer, intent(in) :: id
	integer, intent(inout), dimension(:,:), allocatable :: hel
	call get_helicity_configurations_rcl (id, hel)
	end subroutine rclwrap_get_helicity_configurations

	@ %def rclwrap_get_helicity_configurations
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_color_configurations
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_color_configurations (id, col)
	integer, intent(in) :: id
	integer, intent(out), dimension(:,:), allocatable :: col
	call get_colour_configurations_rcl (id, col)
	end subroutine rclwrap_get_color_configurations

	@ %def rclwrap_get_color_configurations
	@ Selects dimensional regularization for soft singularities.
	<<Recola wrapper: public>>=
	public :: rclwrap_use_dim_reg_soft
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_use_dim_reg_soft ()
	if (debug_on) call msg_debug2 (D_ME_METHODS, "use_dim_reg_soft_rcl")
	call use_dim_reg_soft_rcl ()
	end subroutine rclwrap_use_dim_reg_soft

	@ %def rclwrap_use_dim_reg_soft
	@ Selects mass regularization for soft singularities and sets
	the mass regulator in GeV to [[m]].
	<<Recola wrapper: public>>=
	public :: rclwrap_use_mass_reg_soft
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_use_mass_reg_soft (m)
	real(double), intent(in) :: m
	if (debug_on) call msg_debug2 (D_ME_METHODS, "use_mass_reg_soft_rcl")
	call use_mass_reg_soft_rcl (m)
	end subroutine rclwrap_use_mass_reg_soft

	@ %def rclwrap_use_mass_reg_soft
	@ Sets the UV pole parameterization $\Delta_{UV}$.
	<<Recola wrapper: public>>=
	public :: rclwrap_set_delta_uv
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_delta_uv (d)
	real(double), intent(in) :: d
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_delta_uv_rcl")
	call set_delta_uv_rcl (d)
	end subroutine rclwrap_set_delta_uv

	@ %def rclwrap_set_delta_uv
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_mu_uv
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_mu_uv (mu)
	real(double), intent(in) :: mu
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_mu_uv_rcl")
	call set_mu_uv_rcl (mu)
	end subroutine rclwrap_set_mu_uv

	@ %def rclwrap_set_mu_uv
	@ Sets the IR pole parameterizations $\Delta_{IR}$ and $\Delta_2$.
	<<Recola wrapper: public>>=
	public :: rclwrap_set_delta_ir
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_delta_ir (d, d2)
	real(double), intent(in) :: d, d2
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_delta_ir_rcl", &
	real(d, kind=default))
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_delta_ir_rcl", &
	real(d2, kind=default))
	call set_delta_ir_rcl (d, d2)
	end subroutine rclwrap_set_delta_ir

	@ %def rclwrap_set_delta_ir
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_mu_ir
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_mu_ir (mu)
	real(double), intent(in) :: mu
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_mu_ir_rcl")
	call set_mu_ir_rcl (mu)
	end subroutine rclwrap_set_mu_ir

	@ %def rclwrap_set_mu_ir
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_renormalization_scale
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_renormalization_scale (mu)
	real(double), intent(out) :: mu
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_renormalization_scale_rcl")
	call get_renormalization_scale_rcl (mu)
	end subroutine rclwrap_get_renormalization_scale

	@ %def rclwrap_get_renormalization_scale
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_flavor_scheme
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_flavor_scheme (nf)
	integer, intent(out) :: nf
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_flavour_scheme_rcl")
	call get_flavour_scheme_rcl (nf)
	end subroutine rclwrap_get_flavor_scheme

	@ %def rclwrap_get_flavor_scheme
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_use_alpha0_scheme
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_use_alpha0_scheme (al0)
	real(double), intent(in), optional :: al0
	if (debug_on) call msg_debug2 (D_ME_METHODS, "use_alpha0_scheme_rcl")
	call use_alpha0_scheme_rcl (al0)
	end subroutine rclwrap_use_alpha0_scheme

	@ %def rclwrap_use_alpha0_scheme
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_use_alphaz_scheme
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_use_alphaz_scheme (alz)
	real(double), intent(in), optional :: alz
	if (debug_on) call msg_debug2 (D_ME_METHODS, "use_alphaz_scheme_rcl")
	call use_alphaz_scheme_rcl (alz)
	end subroutine rclwrap_use_alphaz_scheme

	@ %def rclwrap_use_alphaz_scheme
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_complex_mass_scheme
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_complex_mass_scheme ()
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_complex_mass_scheme_rcl")
	call set_complex_mass_scheme_rcl ()
	end subroutine rclwrap_set_complex_mass_scheme

	@ %def rclwrap_set_complex_mass_scheme
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_resonant_particle
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_resonant_particle (pdg_id)
	integer, intent(in) :: pdg_id
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_resonant_particle_rcl")
	call set_resonant_particle_rcl (char(get_recola_particle_string (pdg_id)))
	end subroutine rclwrap_set_resonant_particle

	@ %def rclwrap_set_resonant_particle
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_switch_on_resonant_self_energies
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_switch_on_resonant_self_energies ()
	if (debug_on) call msg_debug2 (D_ME_METHODS, "switchon_resonant_selfenergies_rcl")
	call switchon_resonant_selfenergies_rcl ()
	end subroutine rclwrap_switch_on_resonant_self_energies

	@ %def rclwrap_switch_on_resonant_self_energies
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_switch_off_resonant_self_energies
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_switch_off_resonant_self_energies ()
	if (debug_on) call msg_debug2 (D_ME_METHODS, "switchoff_resonant_selfenergies_rcl")
	call switchoff_resonant_selfenergies_rcl ()
	end subroutine rclwrap_switch_off_resonant_self_energies

	@ %def rclwrap_switch_off_resonant_self_energies
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_draw_level_branches
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_draw_level_branches (n)
	integer, intent(in) :: n
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_draw_level_branches_rcl")
	call set_draw_level_branches_rcl (n)
	end subroutine rclwrap_set_draw_level_branches

	@ %def rclwrap_set_draw_level_branches
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_print_level_amplitude
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_print_level_amplitude (n)
	integer, intent(in) :: n
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_print_level_amplitude_rcl")
	call set_print_level_amplitude_rcl (n)
	end subroutine rclwrap_set_print_level_amplitude

	@ %def rclwrap_set_print_level_amplitude
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_print_level_squared_amplitude
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_print_level_squared_amplitude (n)
	integer, intent(in) :: n
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_print_level_squared_amplitude_rcl")
	call set_print_level_squared_amplitude_rcl (n)
	end subroutine rclwrap_set_print_level_squared_amplitude

	@ %def rclwrap_set_print_level_squared_amplitude
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_print_level_correlations
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_print_level_correlations (n)
	integer, intent(in) :: n
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_print_level_correlations_rcl")
	call set_print_level_correlations_rcl (n)
	end subroutine rclwrap_set_print_level_correlations

	@ %def rclwrap_set_print_level_correlations
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_print_level_RAM
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_print_level_RAM (n)
	integer, intent(in) :: n
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_print_level_RAM_rcl")
	call set_print_level_RAM_rcl (n)
	end subroutine rclwrap_set_print_level_RAM

	@ %def rclwrap_set_print_level_RAM
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_scale_coupling3
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_scale_coupling3 (pdg_id1, pdg_id2, pdg_id3, factor)
	integer, intent(in) :: pdg_id1, pdg_id2, pdg_id3
	complex(double), intent(in) :: factor
	if (debug_on) call msg_debug2 (D_ME_METHODS, "scale_coupling3_rcl")
	call scale_coupling3_rcl (factor, char(get_recola_particle_string (pdg_id1)), &
	char(get_recola_particle_string (pdg_id2)), char(get_recola_particle_string (pdg_id3)))
	end subroutine rclwrap_scale_coupling3

	@ %def rclwrap_scale_coupling3
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_scale_coupling4
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_scale_coupling4 (pdg_id1, pdg_id2, pdg_id3, pdg_id4, factor)
	integer, intent(in) :: pdg_id1, pdg_id2, pdg_id3, pdg_id4
	complex(double), intent(in) :: factor
	if (debug_on) call msg_debug2 (D_ME_METHODS, "scale_coupling4_rcl")
	call scale_coupling4_rcl (factor, char(get_recola_particle_string (pdg_id1)), &
	char(get_recola_particle_string (pdg_id2)), char(get_recola_particle_string (pdg_id3)), &
	char(get_recola_particle_string (pdg_id4)))
	end subroutine rclwrap_scale_coupling4

	@ %def rclwrap_scale_coupling4
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_switch_off_coupling3
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_switch_off_coupling3 (pdg_id1, pdg_id2, pdg_id3)
	integer, intent(in) :: pdg_id1, pdg_id2, pdg_id3
	if (debug_on) call msg_debug2 (D_ME_METHODS, "switchoff_coupling3_rcl")
	call switchoff_coupling3_rcl (char(get_recola_particle_string (pdg_id1)), &
	char(get_recola_particle_string (pdg_id2)), char(get_recola_particle_string (pdg_id3)))
	end subroutine rclwrap_switch_off_coupling3

	@ %def rclwrap_switch_off_coupling3
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_switch_off_coupling4
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_switch_off_coupling4 (pdg_id1, pdg_id2, pdg_id3, pdg_id4)
	integer, intent(in) :: pdg_id1, pdg_id2, pdg_id3, pdg_id4
	if (debug_on) call msg_debug2 (D_ME_METHODS, "switchoff_coupling4_rcl")
	call switchoff_coupling4_rcl &
	(char(get_recola_particle_string (pdg_id1)), &
	char(get_recola_particle_string (pdg_id2)), &
	char(get_recola_particle_string (pdg_id3)), &
	char(get_recola_particle_string (pdg_id4)))
	end subroutine rclwrap_switch_off_coupling4

	@ %def rclwrap_switch_off_coupling4
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_ifail
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_ifail (i)
	integer, intent(in) :: i
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_ifail_rcl")
	call set_ifail_rcl (i)
	end subroutine rclwrap_set_ifail

	@ %def rclwrap_set_ifail
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_ifail
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_ifail (i)
	integer, intent(out) :: i
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_ifail_rcl")
	call get_ifail_rcl (i)
	end subroutine rclwrap_get_ifail

	@ %def rclwrap_get_ifail
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_output_file
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_output_file (filename)
	character(len=*), intent(in) :: filename
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_output_file_rcl")
	call set_output_file_rcl (filename)
	end subroutine rclwrap_set_output_file

	@ %def rclwrap_set_output_file
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_gs_power
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_gs_power (id, gs_array)
	integer, intent(in) :: id
	integer, dimension(:,:), intent(in) :: gs_array
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_gs_power_rcl")
	call set_gs_power_rcl (id, gs_array)
	end subroutine rclwrap_set_gs_power

	@ %def rclwrap_set_gs_power
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_select_gs_power_born_amp
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_select_gs_power_born_amp (id, gs_power)
	integer, intent(in) :: id, gs_power
	if (debug_on) call msg_debug2 (D_ME_METHODS, "select_gs_power_BornAmpl_rcl")
	call select_gs_power_BornAmpl_rcl (id, gs_power)
	end subroutine rclwrap_select_gs_power_born_amp

	@ %def rclwrap_select_gs_power_born_amp
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_unselect_gs_power_born_amp
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_unselect_gs_power_born_amp (id, gs_power)
	integer, intent(in) :: id, gs_power
	if (debug_on) call msg_debug2 (D_ME_METHODS, "unselect_gs_power_BornAmpl_rcl")
	call unselect_gs_power_BornAmpl_rcl (id, gs_power)
	end subroutine rclwrap_unselect_gs_power_born_amp

	@ %def rclwrap_unselect_gs_power_born_amp
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_select_gs_power_loop_amp
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_select_gs_power_loop_amp (id, gs_power)
	integer, intent(in) :: id, gs_power
	if (debug_on) call msg_debug2 (D_ME_METHODS, "select_gs_power_LoopAmpl_rcl")
	call select_gs_power_LoopAmpl_rcl (id, gs_power)
	end subroutine rclwrap_select_gs_power_loop_amp

	@ %def rclwrap_select_gs_power_loop_amp
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_unselect_gs_power_loop_amp
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_unselect_gs_power_loop_amp (id, gs_power)
	integer, intent(in) :: id, gs_power
	if (debug_on) call msg_debug2 (D_ME_METHODS, "unselect_gs_power_LoopAmpl_rcl")
	call unselect_gs_power_LoopAmpl_rcl (id, gs_power)
	end subroutine rclwrap_unselect_gs_power_loop_amp

	@ %def rclwrap_unselect_gs_power_loop_amp
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_select_all_gs_powers_born_amp
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_select_all_gs_powers_born_amp (id)
	integer, intent(in) :: id
	if (debug_on) call msg_debug2 (D_ME_METHODS, "select_all_gs_powers_BornAmpl_rcl")
	call select_all_gs_powers_BornAmpl_rcl (id)
	end subroutine rclwrap_select_all_gs_powers_born_amp

	@ %def rclwrap_select_all_gs_powers_born_amp
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_unselect_all_gs_powers_loop_amp
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_unselect_all_gs_powers_loop_amp (id)
	integer, intent(in) :: id
	if (debug_on) call msg_debug2 (D_ME_METHODS, "unselect_all_gs_powers_BornAmpl_rcl")
	call unselect_all_gs_powers_BornAmpl_rcl (id)
	end subroutine rclwrap_unselect_all_gs_powers_loop_amp

	@ %def rclwrap_unselect_all_gs_powers_loop_amp
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_select_all_gs_powers_loop_amp
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_select_all_gs_powers_loop_amp (id)
	integer, intent(in) :: id
	if (debug_on) call msg_debug2 (D_ME_METHODS, "select_all_gs_powers_LoopAmpl_rcl")
	call select_all_gs_powers_LoopAmpl_rcl (id)
	end subroutine rclwrap_select_all_gs_powers_loop_amp

	@ %def rclwrap_select_all_gs_powers_loop_amp
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_unselect_all_gs_powers_born_amp
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_unselect_all_gs_powers_born_amp (id)
	integer, intent(in) :: id
	if (debug_on) call msg_debug2 (D_ME_METHODS, "unselect_all_gs_powers_LoopAmpl_rcl")
	call unselect_all_gs_powers_LoopAmpl_rcl (id)
	end subroutine rclwrap_unselect_all_gs_powers_born_amp

	@ %def rclwrap_unselect_all_gs_powers_born_amp
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_resonant_squared_momentum
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_resonant_squared_momentum (id, i_res, p2)
	integer, intent(in) :: id, i_res
	real(double), intent(in) :: p2
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_resonant_squared_momentum_rcl")
	call set_resonant_squared_momentum_rcl (id, i_res, p2)
	end subroutine rclwrap_set_resonant_squared_momentum

	@ %def rclwrap_set_resonant_squared_momentum
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_compute_running_alpha_s
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_compute_running_alpha_s (Q, nf, n_loops)
	real(double), intent(in) :: Q
	integer, intent(in) :: nf, n_loops
	if (debug_on) call msg_debug2 (D_ME_METHODS, "compute_running_alphas_rcl")
	call compute_running_alphas_rcl (Q, nf, n_loops)
	end subroutine rclwrap_compute_running_alpha_s

	@ %def rclwrap_compute_running_alpha_s
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_set_dynamic_settings
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_set_dynamic_settings ()
	if (debug_on) call msg_debug2 (D_ME_METHODS, "set_dynamic_settings_rcl")
	call set_dynamic_settings_rcl (1)
	end subroutine rclwrap_set_dynamic_settings

	@ %def rclwrap_set_dynamic_settings
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_rescale_process
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_rescale_process (id, order, sqme)
	integer, intent(in) :: id
	character(len=*), intent(in) :: order
	real(double), dimension(0:1), intent(out), optional :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "rescale_process_rcl")
	call rescale_process_rcl (id, order, sqme)
	end subroutine rclwrap_rescale_process

	@ %def rclwrap_rescale_process
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_polarized_squared_amplitude
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_polarized_squared_amplitude (id, &
	alphas_power, order, hel, sqme)
	integer, intent(in) :: id, alphas_power
	character(len=*), intent(in) :: order
	integer, dimension(:), intent(in) :: hel
	real(double), intent(out) :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_polarized_squared_amplitude_rcl")
	call get_polarized_squared_amplitude_rcl (id, alphas_power, &
	order, hel, sqme)
	end subroutine rclwrap_get_polarized_squared_amplitude

	@ %def rclwrap_get_polarized_squared_amplitude
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_compute_color_correlation
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_compute_color_correlation (id, p, &
	i1, i2, sqme)
	integer, intent(in) :: id
	real(double), dimension(:,:), intent(in) :: p
	integer, intent(in) :: i1, i2
	real(double), intent(out), optional :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "compute_colour_correlation_rcl")
	call compute_colour_correlation_rcl (id, p, i1, i2, sqme)
	end subroutine rclwrap_compute_color_correlation

	@ %def rclwrap_compute_color_correlation
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_compute_all_color_correlations
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_compute_all_color_correlations (id, p)
	integer, intent(in) :: id
	real(double), dimension(:,:), intent(in) :: p
	if (debug_on) call msg_debug2 (D_ME_METHODS, "compute_all_colour_correlations_rcl")
	call compute_all_colour_correlations_rcl (id, p)
	end subroutine rclwrap_compute_all_color_correlations

	@ %def rclwrap_compute_all_color_correlations
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_rescale_color_correlation
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_rescale_color_correlation (id, i1, i2, sqme)
	integer, intent(in) :: id, i1, i2
	real(double), intent(out), optional :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "rescale_colour_correlation_rcl")
	call rescale_colour_correlation_rcl (id, i1, i2, sqme)
	end subroutine rclwrap_rescale_color_correlation

	@ %def rclwrap_rescale_color_correlation
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_rescale_all_color_correlations
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_rescale_all_color_correlations (id)
	integer, intent(in) :: id
	if (debug_on) call msg_debug2 (D_ME_METHODS, "rescale_all_colour_correlations_rcl")
	call rescale_all_colour_correlations_rcl (id)
	end subroutine rclwrap_rescale_all_color_correlations

	@ %def rclwrap_rescale_all_color_correlations
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_color_correlation
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_color_correlation (id, alphas_power, i1, i2, sqme)
	integer, intent(in) :: id, alphas_power, i1, i2
	real(double), intent(out) :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_colour_correlation_rcl")
	call get_colour_correlation_rcl (id, alphas_power, i1, i2, sqme)
	end subroutine rclwrap_get_color_correlation

	@ %def rclwrap_get_color_correlation
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_compute_spin_correlation
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_compute_spin_correlation (id, p, i_photon, pol, sqme)
	integer, intent(in) :: id
	real(double), dimension(:,:), intent(in) :: p
	integer, intent(in) :: i_photon
	complex(double), dimension(:), intent(in) :: pol
	real(double), intent(out), optional :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "compute_spin_correlation_rcl")
	call compute_spin_correlation_rcl (id, p, i_photon, pol, sqme)
	end subroutine rclwrap_compute_spin_correlation

	@ %def rclwrap_compute_spin_correlation
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_rescale_spin_correlation
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_rescale_spin_correlation (id, i_photon, pol, sqme)
	integer, intent(in) :: id, i_photon
	complex(double), dimension(:), intent(in) :: pol
	real(double), intent(out), optional :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "rescale_spin_correlation_rcl")
	call rescale_spin_correlation_rcl (id, i_photon, pol, sqme)
	end subroutine rclwrap_rescale_spin_correlation

	@ %def rclwrap_rescale_spin_correlation
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_spin_correlation
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_spin_correlation (id, alphas_power, sqme)
	integer, intent(in) :: id, alphas_power
	real(double), intent(out) :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_spin_correlation_rcl")
	call get_spin_correlation_rcl (id, alphas_power, sqme)
	end subroutine rclwrap_get_spin_correlation

	@ %def rclwrap_get_spin_correlation
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_compute_spin_color_correlation
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_compute_spin_color_correlation (id, p, &
	i_gluon, i_spectator, pol, sqme)
	integer, intent(in) :: id
	real(double), dimension(:,:), intent(in) :: p
	integer, intent(in) :: i_gluon, i_spectator
	complex(double), dimension(:), intent(in) :: pol
	real(double), intent(out), optional :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "compute_spin_colour_correlation_rcl")
	call compute_spin_colour_correlation_rcl (id, p, &
	i_gluon, i_spectator, pol, sqme)
	end subroutine rclwrap_compute_spin_color_correlation

	@ %def rclwrap_compute_spin_color_correlation
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_rescale_spin_color_correlation
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_rescale_spin_color_correlation (id, i_gluon, &
	i_spectator, pol, sqme)
	integer, intent(in) :: id, i_gluon, i_spectator
	complex(double), dimension(:), intent(in) :: pol
	real(double), intent(out), optional :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "rescale_spin_colour_correlation_rcl")
	call rescale_spin_colour_correlation_rcl (id, i_gluon, &
	i_spectator, pol, sqme)
	end subroutine rclwrap_rescale_spin_color_correlation

	@ %def rclwrap_rescale_spin_color_correlation
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_spin_color_correlation
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_spin_color_correlation (id, alphas_power, &
	i_gluon, i_spectator, sqme)
	integer, intent(in) :: id, alphas_power, i_gluon, i_spectator
	real(double), intent(out) :: sqme
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_spin_colour_correlation_rcl")
	call get_spin_colour_correlation_rcl (id, alphas_power, &
	i_gluon, i_spectator, sqme)
	end subroutine rclwrap_get_spin_color_correlation

	@ %def rclwrap_get_spin_color_correlation
	@
	<<Recola wrapper: public>>=
	public :: rclwrap_get_momenta
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_get_momenta (id, p)
	integer, intent(in) :: id
	real(double), dimension(:,:), intent(out) :: p
	if (debug_on) call msg_debug2 (D_ME_METHODS, "get_momenta_rcl")
	call get_momenta_rcl (id, p)
	end subroutine rclwrap_get_momenta

	@ %def rclwrap_get_momenta
	@
	The reset routine is essential. But note that it doesn't reset the
	Recola parameters, just the processes.

	For LOL, Recola's reset routine crashes the program if there was no
	process before. So, rather reset indirectly via the controller.
	<<Recola wrapper: public>>=
	public :: rclwrap_reset_recola
	<<Recola wrapper: procedures>>=
	subroutine rclwrap_reset_recola
	if (debug_on) call msg_debug (D_ME_METHODS, "rclwrap_reset_recola")
	call rcl_controller%reset ()
	end subroutine rclwrap_reset_recola

	@ %def rclwrap_reset_recola
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Recola dummy replacement module}
	<<[[recola_wrapper_dummy.f90]]>>=
	<<File header>>

	module recola_wrapper

	use kinds
	<<Use strings>>

	<<Standard module head>>

	<<Recola wrapper dummy: public>>

	<<Recola wrapper dummy: parameters>>

	contains

	<<Recola wrapper dummy: procedures>>

	end module recola_wrapper
	@ %def recola_wrapper_dummy
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_is_active
	<<Recola wrapper dummy: parameters>>=
	logical, parameter :: rclwrap_is_active = .false.

	@ %def rclwrap_is_active
	@
	<<Recola wrapper dummy: public>>=
	public :: get_recola_particle_string
	<<Recola wrapper dummy: procedures>>=
	elemental function get_recola_particle_string (pdg) result (name)
	type(string_t) :: name
	integer, intent(in) :: pdg
	name = var_str ("?")
	end function get_recola_particle_string

	@ %def get_recola_paritcle_string
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_new_recola_id
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_new_recola_id (id)
	integer, intent(out) :: id
	id = 0
	end subroutine rclwrap_get_new_recola_id

	@ %def rclwrap_get_new_recola_id
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_current_recola_id
	<<Recola wrapper dummy: procedures>>=
	function rclwrap_get_current_recola_id () result (n)
	integer :: n
	n = 0
	end function rclwrap_get_current_recola_id

	@ %def rclwrap_get_current_recola_id
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_request_generate_processes
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_request_generate_processes ()
	end subroutine rclwrap_request_generate_processes

	@ %def rclwrap_request_generate_processes
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_add_process
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_add_process (id, process_string, order)
	integer, intent(in) :: id
	type(string_t), intent(in) :: process_string, order
	end subroutine rclwrap_add_process

	@ %def rclwrap_add_process
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_define_processes
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_define_processes ()
	end subroutine rclwrap_define_processes

	@ %def rclwrap_define_processes
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_generate_processes
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_generate_processes ()
	end subroutine rclwrap_generate_processes

	@ %def rclwrap_generate_processes
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_compute_process
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_compute_process (id, p, order, sqme)
	integer, intent(in) :: id
	real(double), intent(in), dimension(:,:) :: p
	character(len=*), intent(in) :: order
	real(double), intent(out), dimension(0:1), optional :: sqme
	end subroutine rclwrap_compute_process

	@ %def rclwrap_compute_process
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_amplitude
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_amplitude (id, g_power, order, col, hel, amp)
	integer, intent(in) :: id, g_power
	character(len=*), intent(in) :: order
	integer, dimension(:), intent(in) :: col, hel
	complex(double), intent(out) :: amp
	end subroutine rclwrap_get_amplitude

	@ %def rclwrap_get_amplitude
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_squared_amplitude
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_squared_amplitude (id, alphas_power, order, sqme)
	integer, intent(in) :: id, alphas_power
	character(len=*), intent(in) :: order
	real(double), intent(out) :: sqme
	end subroutine rclwrap_get_squared_amplitude

	@ %def rclwrap_get_squared_amplitude
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_pole_mass
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_pole_mass (pdg_id, mass, width)
	integer, intent(in) :: pdg_id
	real(double), intent(in) :: mass, width
	end subroutine rclwrap_set_pole_mass

	@ %def rclwrap_set_pole_mass
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_onshell_mass
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_onshell_mass (pdg_id, mass, width)
	integer, intent(in) :: pdg_id
	real(double), intent(in) :: mass, width
	end subroutine rclwrap_set_onshell_mass

	@ %def rclwrap_set_onshell_mass
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_use_gfermi_scheme
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_use_gfermi_scheme (gf)
	real(double), intent(in), optional :: gf
	end subroutine rclwrap_use_gfermi_scheme

	@ %def rclwrap_use_gfermi_scheme
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_light_fermions
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_light_fermions (m)
	real(double), intent(in) :: m
	end subroutine rclwrap_set_light_fermions

	@ %def rclwrap_set_light_fermions
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_light_fermion
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_light_fermion (pdg_id)
	integer, intent(in) :: pdg_id
	end subroutine rclwrap_set_light_fermion

	@ %def rclwrap_set_light_fermion
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_unset_light_fermion
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_unset_light_fermion (pdg_id)
	integer, intent(in) :: pdg_id
	end subroutine rclwrap_unset_light_fermion

	@ %def rclwrap_unset_light_fermion
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_onshell_scheme
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_onshell_scheme
	end subroutine rclwrap_set_onshell_scheme

	@ %def rclwrap_set_onshell_scheme
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_alpha_s
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_alpha_s (alpha_s, mu, nf)
	real(double), intent(in) :: alpha_s, mu
	integer, intent(in) :: nf
	end subroutine rclwrap_set_alpha_s

	@ %def rclwrap_set_alpha_s
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_alpha_s
	<<Recola wrapper dummy: procedures>>=
	function rclwrap_get_alpha_s () result (alpha_s)
	real(double) :: alpha_s
	end function rclwrap_get_alpha_s

	@ %def rclwrap_get_alpha_s
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_alpha
	<<Recola wrapper dummy: procedures>>=
	function rclwrap_get_alpha () result (alpha)
	real(double) :: alpha
	end function rclwrap_get_alpha

	@ %def rclwrap_get_alpha
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_helicity_configurations
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_helicity_configurations (id, hel)
	integer, intent(in) :: id
	integer, intent(inout), dimension(:,:), allocatable :: hel
	end subroutine rclwrap_get_helicity_configurations

	@ %def rclwrap_get_helicity_configurations
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_color_configurations
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_color_configurations (id, col)
	integer, intent(in) :: id
	integer, intent(out), dimension(:,:), allocatable :: col
	end subroutine rclwrap_get_color_configurations

	@ %def rclwrap_get_color_configurations
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_use_dim_reg_soft
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_use_dim_reg_soft ()
	end subroutine rclwrap_use_dim_reg_soft

	@ %def rclwrap_use_dim_reg_soft
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_use_mass_reg_soft
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_use_mass_reg_soft (m)
	real(double), intent(in) :: m
	end subroutine rclwrap_use_mass_reg_soft

	@ %def rclwrap_use_mass_reg_soft
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_delta_uv
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_delta_uv (d)
	real(double), intent(in) :: d
	end subroutine rclwrap_set_delta_uv

	@ %def rclwrap_set_delta_uv
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_mu_uv
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_mu_uv (mu)
	real(double), intent(in) :: mu
	end subroutine rclwrap_set_mu_uv

	@ %def rclwrap_set_mu_uv
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_delta_ir
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_delta_ir (d, d2)
	real(double), intent(in) :: d, d2
	end subroutine rclwrap_set_delta_ir

	@ %def rclwrap_set_delta_ir
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_mu_ir
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_mu_ir (mu)
	real(double), intent(in) :: mu
	end subroutine rclwrap_set_mu_ir

	@ %def rclwrap_set_mu_ir
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_renormalization_scale
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_renormalization_scale (mu)
	real(double), intent(out) :: mu
	end subroutine rclwrap_get_renormalization_scale

	@ %def rclwrap_get_renormalization_scale
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_flavor_scheme
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_flavor_scheme (nf)
	integer, intent(out) :: nf
	end subroutine rclwrap_get_flavor_scheme

	@ %def rclwrap_get_flavor_scheme
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_use_alpha0_scheme
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_use_alpha0_scheme (al0)
	real(double), intent(in), optional :: al0
	end subroutine rclwrap_use_alpha0_scheme

	@ %def rclwrap_use_alpha0_scheme
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_use_alphaz_scheme
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_use_alphaz_scheme (alz)
	real(double), intent(in), optional :: alz
	end subroutine rclwrap_use_alphaz_scheme

	@ %def rclwrap_use_alphaz_scheme
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_complex_mass_scheme
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_complex_mass_scheme ()
	end subroutine rclwrap_set_complex_mass_scheme

	@ %def rclwrap_set_complex_mass_scheme
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_resonant_particle
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_resonant_particle (pdg_id)
	integer, intent(in) :: pdg_id
	end subroutine rclwrap_set_resonant_particle

	@ %def rclwrap_set_resonant_particle
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_switch_on_resonant_self_energies
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_switch_on_resonant_self_energies ()
	end subroutine rclwrap_switch_on_resonant_self_energies

	@ %def rclwrap_switch_on_resonant_self_energies
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_switch_off_resonant_self_energies
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_switch_off_resonant_self_energies ()
	end subroutine rclwrap_switch_off_resonant_self_energies

	@ %def rclwrap_switch_off_resonant_self_energies
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_draw_level_branches
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_draw_level_branches (n)
	integer, intent(in) :: n
	end subroutine rclwrap_set_draw_level_branches

	@ %def rclwrap_set_draw_level_branches
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_print_level_amplitude
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_print_level_amplitude (n)
	integer, intent(in) :: n
	end subroutine rclwrap_set_print_level_amplitude

	@ %def rclwrap_set_print_level_amplitude
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_print_level_squared_amplitude
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_print_level_squared_amplitude (n)
	integer, intent(in) :: n
	end subroutine rclwrap_set_print_level_squared_amplitude

	@ %def rclwrap_set_print_level_squared_amplitude
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_print_level_correlations
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_print_level_correlations (n)
	integer, intent(in) :: n
	end subroutine rclwrap_set_print_level_correlations

	@ %def rclwrap_set_print_level_correlations
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_print_level_RAM
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_print_level_RAM (n)
	integer, intent(in) :: n
	end subroutine rclwrap_set_print_level_RAM

	@ %def rclwrap_set_print_level_RAM
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_scale_coupling3
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_scale_coupling3 (pdg_id1, pdg_id2, pdg_id3, factor)
	integer, intent(in) :: pdg_id1, pdg_id2, pdg_id3
	complex(double), intent(in) :: factor
	end subroutine rclwrap_scale_coupling3

	@ %def rclwrap_scale_coupling3
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_scale_coupling4
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_scale_coupling4 (pdg_id1, pdg_id2, pdg_id3, pdg_id4, factor)
	integer, intent(in) :: pdg_id1, pdg_id2, pdg_id3, pdg_id4
	complex(double), intent(in) :: factor
	end subroutine rclwrap_scale_coupling4

	@ %def rclwrap_scale_coupling4
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_switch_off_coupling3
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_switch_off_coupling3 (pdg_id1, pdg_id2, pdg_id3)
	integer, intent(in) :: pdg_id1, pdg_id2, pdg_id3
	end subroutine rclwrap_switch_off_coupling3

	@ %def rclwrap_switch_off_coupling3
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_switch_off_coupling4
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_switch_off_coupling4 (pdg_id1, pdg_id2, pdg_id3, pdg_id4)
	integer, intent(in) :: pdg_id1, pdg_id2, pdg_id3, pdg_id4
	end subroutine rclwrap_switch_off_coupling4

	@ %def rclwrap_switch_off_coupling4
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_ifail
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_ifail (i)
	integer, intent(in) :: i
	end subroutine rclwrap_set_ifail

	@ %def rclwrap_set_ifail
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_ifail
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_ifail (i)
	integer, intent(out) :: i
	end subroutine rclwrap_get_ifail

	@ %def rclwrap_get_ifail
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_output_file
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_output_file (filename)
	character(len=*), intent(in) :: filename
	end subroutine rclwrap_set_output_file

	@ %def rclwrap_set_output_file
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_gs_power
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_gs_power (id, gs_array)
	integer, intent(in) :: id
	integer, dimension(:,:), intent(in) :: gs_array
	end subroutine rclwrap_set_gs_power

	@ %def rclwrap_set_gs_power
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_select_gs_power_born_amp
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_select_gs_power_born_amp (id, gs_power)
	integer, intent(in) :: id, gs_power
	end subroutine rclwrap_select_gs_power_born_amp

	@ %def rclwrap_select_gs_power_born_amp
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_unselect_gs_power_born_amp
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_unselect_gs_power_born_amp (id, gs_power)
	integer, intent(in) :: id, gs_power
	end subroutine rclwrap_unselect_gs_power_born_amp

	@ %def rclwrap_unselect_gs_power_born_amp
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_select_gs_power_loop_amp
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_select_gs_power_loop_amp (id, gs_power)
	integer, intent(in) :: id, gs_power
	end subroutine rclwrap_select_gs_power_loop_amp

	@ %def rclwrap_select_gs_power_loop_amp
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_unselect_gs_power_loop_amp
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_unselect_gs_power_loop_amp (id, gs_power)
	integer, intent(in) :: id, gs_power
	end subroutine rclwrap_unselect_gs_power_loop_amp

	@ %def rclwrap_unselect_gs_power_loop_amp
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_select_all_gs_powers_born_amp
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_select_all_gs_powers_born_amp (id)
	integer, intent(in) :: id
	end subroutine rclwrap_select_all_gs_powers_born_amp

	@ %def rclwrap_select_all_gs_powers_born_amp
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_unselect_all_gs_powers_loop_amp
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_unselect_all_gs_powers_loop_amp (id)
	integer, intent(in) :: id
	end subroutine rclwrap_unselect_all_gs_powers_loop_amp

	@ %def rclwrap_unselect_all_gs_powers_loop_amp
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_select_all_gs_powers_loop_amp
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_select_all_gs_powers_loop_amp (id)
	integer, intent(in) :: id
	end subroutine rclwrap_select_all_gs_powers_loop_amp

	@ %def rclwrap_select_all_gs_powers_loop_amp
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_unselect_all_gs_powers_born_amp
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_unselect_all_gs_powers_born_amp (id)
	integer, intent(in) :: id
	end subroutine rclwrap_unselect_all_gs_powers_born_amp

	@ %def rclwrap_unselect_all_gs_powers_born_amp
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_resonant_squared_momentum
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_resonant_squared_momentum (id, i_res, p2)
	integer, intent(in) :: id, i_res
	real(double), intent(in) :: p2
	end subroutine rclwrap_set_resonant_squared_momentum

	@ %def rclwrap_set_resonant_squared_momentum
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_compute_running_alpha_s
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_compute_running_alpha_s (Q, nf, n_loops)
	real(double), intent(in) :: Q
	integer, intent(in) :: nf, n_loops
	end subroutine rclwrap_compute_running_alpha_s

	@ %def rclwrap_compute_running_alpha_s
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_set_dynamic_settings
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_set_dynamic_settings ()
	end subroutine rclwrap_set_dynamic_settings

	@ %def rclwrap_set_dynamic_settings
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_rescale_process
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_rescale_process (id, order, sqme)
	integer, intent(in) :: id
	character(len=*), intent(in) :: order
	real(double), dimension(0:1), intent(out), optional :: sqme
	end subroutine rclwrap_rescale_process

	@ %def rclwrap_rescale_process
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_polarized_squared_amplitude
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_polarized_squared_amplitude (id, &
	alphas_power, order, hel, sqme)
	integer, intent(in) :: id, alphas_power
	character(len=*), intent(in) :: order
	integer, dimension(:), intent(in) :: hel
	real(double), intent(out) :: sqme
	end subroutine rclwrap_get_polarized_squared_amplitude

	@ %def rclwrap_get_polarized_squared_amplitude
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_compute_color_correlation
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_compute_color_correlation (id, p, &
	i1, i2, sqme)
	integer, intent(in) :: id
	real(double), dimension(:,:), intent(in) :: p
	integer, intent(in) :: i1, i2
	real(double), intent(out), optional :: sqme
	end subroutine rclwrap_compute_color_correlation

	@ %def rclwrap_compute_color_correlation
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_compute_all_color_correlations
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_compute_all_color_correlations (id, p)
	integer, intent(in) :: id
	real(double), dimension(:,:), intent(in) :: p
	end subroutine rclwrap_compute_all_color_correlations

	@ %def rclwrap_compute_all_color_correlations
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_rescale_color_correlation
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_rescale_color_correlation (id, i1, i2, sqme)
	integer, intent(in) :: id, i1, i2
	real(double), intent(out), optional :: sqme
	end subroutine rclwrap_rescale_color_correlation

	@ %def rclwrap_rescale_color_correlation
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_rescale_all_color_correlations
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_rescale_all_color_correlations (id)
	integer, intent(in) :: id
	end subroutine rclwrap_rescale_all_color_correlations

	@ %def rclwrap_rescale_all_color_correlations
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_color_correlation
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_color_correlation (id, alphas_power, i1, i2, sqme)
	integer, intent(in) :: id, alphas_power, i1, i2
	real(double), intent(out) :: sqme
	end subroutine rclwrap_get_color_correlation

	@ %def rclwrap_get_color_correlation
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_compute_spin_correlation
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_compute_spin_correlation (id, p, i_photon, pol, sqme)
	integer, intent(in) :: id
	real(double), dimension(:,:), intent(in) :: p
	integer, intent(in) :: i_photon
	complex(double), dimension(:), intent(in) :: pol
	real(double), intent(out), optional :: sqme
	end subroutine rclwrap_compute_spin_correlation

	@ %def rclwrap_compute_spin_correlation
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_rescale_spin_correlation
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_rescale_spin_correlation (id, i_photon, pol, sqme)
	integer, intent(in) :: id, i_photon
	complex(double), dimension(:), intent(in) :: pol
	real(double), intent(out), optional :: sqme
	end subroutine rclwrap_rescale_spin_correlation

	@ %def rclwrap_rescale_spin_correlation
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_spin_correlation
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_spin_correlation (id, alphas_power, sqme)
	integer, intent(in) :: id, alphas_power
	real(double), intent(out) :: sqme
	end subroutine rclwrap_get_spin_correlation

	@ %def rclwrap_get_spin_correlation
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_compute_spin_color_correlation
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_compute_spin_color_correlation (id, p, &
	i_gluon, i_spectator, pol, sqme)
	integer, intent(in) :: id
	real(double), dimension(:,:), intent(in) :: p
	integer, intent(in) :: i_gluon, i_spectator
	complex(double), dimension(:), intent(in) :: pol
	real(double), intent(out), optional :: sqme
	end subroutine rclwrap_compute_spin_color_correlation

	@ %def rclwrap_compute_spin_color_correlation
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_rescale_spin_color_correlation
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_rescale_spin_color_correlation (id, i_gluon, &
	i_spectator, pol, sqme)
	integer, intent(in) :: id, i_gluon, i_spectator
	complex(double), dimension(:), intent(in) :: pol
	real(double), intent(out), optional :: sqme
	end subroutine rclwrap_rescale_spin_color_correlation

	@ %def rclwrap_rescale_spin_color_correlation
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_spin_color_correlation
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_spin_color_correlation (id, alphas_power, &
	i_gluon, i_spectator, sqme)
	integer, intent(in) :: id, alphas_power, i_gluon, i_spectator
	real(double), intent(out) :: sqme
	end subroutine rclwrap_get_spin_color_correlation

	@ %def rclwrap_get_spin_color_correlation
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_get_momenta
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_get_momenta (id, p)
	integer, intent(in) :: id
	real(double), dimension(:,:), intent(out) :: p
	end subroutine rclwrap_get_momenta

	@ %def rclwrap_get_momenta
	@
	<<Recola wrapper dummy: public>>=
	public :: rclwrap_reset_recola
	<<Recola wrapper dummy: procedures>>=
	subroutine rclwrap_reset_recola
	end subroutine rclwrap_reset_recola

	@ %def rclwrap_reset_recola
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Recola Core}
	The recola core object and auxiliary types and objects.
	<<[[prc_recola.f90]]>>=
	<<File header>>

	module prc_recola

	use kinds
	<<Use strings>>
	<<Use debug>>
	use diagnostics
	use lorentz
	use physics_defs
	use variables, only: var_list_t
	use os_interface, only: os_data_t
	use sm_qcd, only: qcd_t
	use model_data, only: model_data_t

	use prc_core, only: prc_core_state_t
	use prc_core_def, only: prc_core_driver_t, prc_core_def_t
	use prc_external
	use process_libraries, only: process_library_t

	<<Standard module head>>

	<<Prc recola: public>>

	<<Prc recola: parameters>>

	<<Prc recola: types>>

	<<Prc recola: interfaces>>

	interface
	<<Prc recola: sub interfaces>>
	end interface

	contains

	<<Prc recola: main procedures>>

	end module prc_recola
	@ %def prc_recola
	@
	<<[[prc_recola_sub.f90]]>>=
	<<File header>>

	submodule (prc_recola) prc_recola_s

	use constants, only: pi, zero
	use string_utils, only: str
	use system_defs, only: TAB
	use io_units
	use recola_wrapper !NODEP!
	!!! Intel oneAPI 2022/23 regression workaround
	use os_interface, only: os_data_t
	use variables, only: var_list_t
	use sm_qcd, only: qcd_t
	use model_data, only: model_data_t
	use prc_core, only: prc_core_state_t
	use prc_core_def, only: prc_core_driver_t, prc_core_def_t
	use process_libraries, only: process_library_t

	implicit none

	contains

	<<Prc recola: procedures>>

	end submodule prc_recola_s

	@ %def prc_recola_s
	@
	\subsection{Sanity check}
	Checks the [[rclwrap_is_active]] flag and aborts the program if the dummy
	is used.
	<<Prc recola: public>>=
	public :: abort_if_recola_not_active
	<<Prc recola: sub interfaces>>=
	module subroutine abort_if_recola_not_active ()
	end subroutine abort_if_recola_not_active
	<<Prc recola: procedures>>=
	module subroutine abort_if_recola_not_active ()
	if (.not. rclwrap_is_active) call msg_fatal ("You want to use Recola, ", &
	[var_str("but either the compiler with which Whizard has been build "), &
	var_str("is not supported by it, or you have not linked Recola "), &
	var_str("correctly to Whizard. Either reconfigure Whizard with a path to "), &
	var_str("a valid Recola installation (for details consult the manual), "), &
	var_str("or choose a different matrix-element method.")])
	end subroutine abort_if_recola_not_active

	@ %def abort_if_recola_not_active
	@
	\subsection{Process definition}
	When defining a RECOLA process, we store the process-specific flags
	and parameters. Correction types are either QCD, EW, or full SM.
	<<Prc recola: parameters>>=
	integer, parameter :: RECOLA_UNDEFINED = 0, RECOLA_QCD = 1, &
	RECOLA_EW = 2, RECOLA_FULL = 3

	@ %def RECOLA_QCD RECOLA_EW RECOLA_FULL
	@
	<<Prc recola: public>>=
	public :: recola_def_t
	<<Prc recola: types>>=
	type, extends (prc_external_def_t) :: recola_def_t
	type(string_t) :: suffix
	type(string_t) :: order
	integer :: alpha_power = 0
	integer :: alphas_power = 0
	integer :: corr = RECOLA_UNDEFINED
	contains
	<<Prc recola: recola def: TBP>>
	end type recola_def_t

	@ %def recola_def_t
	@
	<<Prc recola: recola def: TBP>>=
	procedure, nopass :: type_string => recola_def_type_string
	<<Prc recola: sub interfaces>>=
	module function recola_def_type_string () result (string)
	type(string_t) :: string
	end function recola_def_type_string
	<<Prc recola: procedures>>=
	module function recola_def_type_string () result (string)
	type(string_t) :: string
	string = "recola"
	end function recola_def_type_string

	@ %def recola_def_type_string
	@
	Not implemented yet.
	<<Prc recola: recola def: TBP>>=
	procedure :: write => recola_def_write
	<<Prc recola: sub interfaces>>=
	module subroutine recola_def_write (object, unit)
	class(recola_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine recola_def_write
	<<Prc recola: procedures>>=
	module subroutine recola_def_write (object, unit)
	class(recola_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine recola_def_write

	@ %def recola_def_write
	@
	<<Prc recola: recola def: TBP>>=
	procedure :: read => recola_def_read
	<<Prc recola: sub interfaces>>=
	module subroutine recola_def_read (object, unit)
	class(recola_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine recola_def_read
	<<Prc recola: procedures>>=
	module subroutine recola_def_read (object, unit)
	class(recola_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine recola_def_read

	@ %def recola_def_read
	@
	The initializer has the responsibility to store all process- and
	method-specific parameters, such that they can be used later by the
	writer and by the driver for this process. Also, it allocates the writer.

	For RECOLA, the writer (i) creates full-fledged \oMega\ matrix element
	code which we need for the interface. (ii) registers
	the process definition with the RECOLA library which has been linked.
	The latter task does not involve external code.

	Note that all management stuff is taken care of by the base type(s)
	methods. Here, we introduce only RECOLA-specific procedures, in
	addition.

	The NLO flag is true only for virtual matrix elements.
	Gfortran 7/8/9 bug: has to remain in the main module.
	<<Prc recola: recola def: TBP>>=
	procedure :: init => recola_def_init
	<<Prc recola: main procedures>>=
	subroutine recola_def_init (object, basename, model_name, &
	prt_in, prt_out, nlo_type, alpha_power, alphas_power, &
	- correction_type, restrictions)
	+ correction_type, ufo, ufo_path, restrictions)
	class(recola_def_t), intent(inout) :: object
	type(string_t), intent(in) :: basename, model_name
	type(string_t), dimension(:), intent(in) :: prt_in, prt_out
	integer, intent(in) :: nlo_type
	integer, intent(in) :: alpha_power
	integer, intent(in) :: alphas_power
	type(string_t), intent(in) :: correction_type
	+ logical, intent(in), optional :: ufo
	+ type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	if (debug_on) call msg_debug (D_ME_METHODS, "recola_def_init: " &
	// char (basename) // ", nlo_type", nlo_type)
	object%basename = basename
	object%alpha_power = alpha_power
	object%alphas_power = alphas_power
	select case (char (correction_type))
	case ("QCD")
	object%corr = RECOLA_QCD
	case ("EW")
	object%corr = RECOLA_EW
	case ("Full")
	object%corr = RECOLA_FULL
	end select
	allocate (recola_writer_t :: object%writer)
	select case (nlo_type)
	case (BORN)
	object%suffix = '_BORN'
	object%order = "LO"
	case (NLO_REAL)
	object%suffix = '_REAL'
	object%order = "LO"
	if (object%corr == RECOLA_QCD) object%alphas_power = alphas_power + 1
	if (object%corr == RECOLA_EW) object%alpha_power = alpha_power + 1
	case (NLO_VIRTUAL)
	object%suffix = '_LOOP'
	object%order = "NLO"
	case (NLO_SUBTRACTION)
	object%suffix = '_SUB'
	object%order = "LO"
	case (NLO_MISMATCH)
	object%suffix = '_MISMATCH'
	object%order = "LO"
	case (NLO_DGLAP)
	object%suffix = '_DGLAP'
	object%order = "LO"
	end select
	select type (writer => object%writer)
	class is (recola_writer_t)
	- call writer%init (model_name, prt_in, prt_out, restrictions)
	+ call writer%init (model_name, prt_in, prt_out, ufo, ufo_path, restrictions)
	call writer%set_id (basename // object%suffix)
	call writer%set_order (object%order)
	call writer%set_coupling_powers (object%alpha_power, object%alphas_power)
	end select
	end subroutine recola_def_init

	@ %def recola_def_init
	@
	\subsection{Writer object}
	The RECOLA writer takes the additional resposibility of transferring process
	information to RECOLA.
	<<Prc recola: types>>=
	type, extends (prc_external_writer_t) :: recola_writer_t
	private
	type(string_t) :: id
	type(string_t) :: order
	integer :: alpha_power = 0
	integer :: alphas_power = 0
	contains
	<<Prc recola: recola writer: TBP>>
	end type recola_writer_t

	@ %def recola_writer_t
	@
	<<Prc recola: recola writer: TBP>>=
	procedure, nopass :: type_name => recola_writer_type_name
	<<Prc recola: sub interfaces>>=
	module function recola_writer_type_name () result (string)
	type(string_t) :: string
	end function recola_writer_type_name
	<<Prc recola: procedures>>=
	module function recola_writer_type_name () result (string)
	type(string_t) :: string
	string = "recola"
	end function recola_writer_type_name

	@ %def recola_writer_type_name
	@ Set the process ID string as used by WHIZARD.
	<<Prc recola: recola writer: TBP>>=
	procedure :: set_id => recola_writer_set_id
	<<Prc recola: sub interfaces>>=
	module subroutine recola_writer_set_id (writer, id)
	class(recola_writer_t), intent(inout) :: writer
	type(string_t), intent(in) :: id
	end subroutine recola_writer_set_id
	<<Prc recola: procedures>>=
	module subroutine recola_writer_set_id (writer, id)
	class(recola_writer_t), intent(inout) :: writer
	type(string_t), intent(in) :: id
	if (debug_on) call msg_debug2 &
	(D_ME_METHODS, "Recola writer: id = " // char (id))
	writer%id = id
	end subroutine recola_writer_set_id

	@ %def recola_writer_set_id
	@ Set the NLO flag.
	<<Prc recola: recola writer: TBP>>=
	procedure :: set_order => recola_writer_set_order
	<<Prc recola: sub interfaces>>=
	module subroutine recola_writer_set_order (writer, order)
	class(recola_writer_t), intent(inout) :: writer
	type(string_t), intent(in) :: order
	end subroutine recola_writer_set_order
	<<Prc recola: procedures>>=
	module subroutine recola_writer_set_order (writer, order)
	class(recola_writer_t), intent(inout) :: writer
	type(string_t), intent(in) :: order
	if (debug_on) call msg_debug2 &
	(D_ME_METHODS, "Recola writer: order = " // char (order))
	writer%order = order
	end subroutine recola_writer_set_order

	@ %def recola_writer_set_order
	@ Set coupling powers.
	<<Prc recola: recola writer: TBP>>=
	procedure :: set_coupling_powers => recola_writer_set_coupling_powers
	<<Prc recola: sub interfaces>>=
	module subroutine recola_writer_set_coupling_powers &
	(writer, alpha_power, alphas_power)
	class(recola_writer_t), intent(inout) :: writer
	integer, intent(in) :: alpha_power
	integer, intent(in) :: alphas_power
	end subroutine recola_writer_set_coupling_powers
	<<Prc recola: procedures>>=
	module subroutine recola_writer_set_coupling_powers &
	(writer, alpha_power, alphas_power)
	class(recola_writer_t), intent(inout) :: writer
	integer, intent(in) :: alpha_power
	integer, intent(in) :: alphas_power
	if (debug_on) call msg_debug2 &
	(D_ME_METHODS, "Recola writer: alphas_power", alphas_power)
	if (debug_on) call msg_debug2 &
	(D_ME_METHODS, "Recola writer: alpha_power", alpha_power)
	writer%alpha_power = alpha_power
	writer%alphas_power = alphas_power
	end subroutine recola_writer_set_coupling_powers

	@ %def recola_writer_set_coupling_powers
	@
	The Makefile code contains all of the code that the [[prc_external]] base
	method generates, plus an extra clause that extracts a shorthand listing of
	all flavor combinations for the current process. This list is required by
	[[make source]], so it can be read and used for declaring the RECOLA
	processes.

	There is one glitch here: we use the component-specific source file
	but write a flavor list for the process, without component extension.
	That is, we must not have more than one component at this stage.

	NB: We might actually extend \oMega\ to produce this shorthand listing.
	<<Prc recola: recola writer: TBP>>=
	procedure :: write_makefile_code => recola_writer_write_makefile_code
	<<Prc recola: sub interfaces>>=
	module subroutine recola_writer_write_makefile_code &
	(writer, unit, id, os_data, verbose, testflag)
	class(recola_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	end subroutine recola_writer_write_makefile_code
	<<Prc recola: procedures>>=
	function flv_file_name (id)
	type(string_t), intent(in) :: id
	type(string_t) :: flv_file_name
	flv_file_name = id // ".flv.dat"
	end function flv_file_name

	module subroutine recola_writer_write_makefile_code &
	(writer, unit, id, os_data, verbose, testflag)
	class(recola_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	type(string_t) :: src_file
	type(string_t) :: flv_file
	call writer%base_write_makefile_code (unit, id, os_data, verbose, testflag)
	src_file = trim (char(id)) // ".f90"
	flv_file = flv_file_name (writer%id)
	write (unit, *)
	write (unit, "(5A)") "# Flavor state listing for RECOLA process generation"
	write (unit, "(5A)") char (flv_file), ": ", char (src_file)
	if (verbose) then
	write (unit, "(5A)", advance="no") TAB
	else
	write (unit, "(5A)") TAB, '@echo " MAKE ', char (flv_file), '"'
	write (unit, "(5A)", advance="no") TAB, "@"
	end if
	write (unit, "(5A)") &
	"grep 'data table_flavor_states' $< ", &
	"\| sed -e 's/.\/$.$\/.*/\1/' -e 's/,//g' > $@"
	write (unit, "(5A)") "SOURCES += ", char (flv_file)
	write (unit, "(5A)") "CLEAN_SOURCES += ", char (flv_file)
	end subroutine recola_writer_write_makefile_code

	@ %def recola_writer_write_makefile_code
	@
	To communicate the process definition to RECOLA, we must know the
	following: the process definition, expanded in terms of flavor states,
	and the process order (LO/NLO). We will ask for a new numeric ID,
	create a process string using RECOLA conventions, and define the
	process. The [[request_generate_processes]] enables the RECOLA
	internal process compiler, which can be called only after all
	processes have been defined.
	<<Prc recola: recola writer: TBP>>=
	procedure :: register_processes => prc_recola_register_processes
	<<Prc recola: sub interfaces>>=
	module subroutine prc_recola_register_processes (writer, recola_ids)
	class(recola_writer_t), intent(in) :: writer
	integer, dimension (:), intent(inout) :: recola_ids
	end subroutine prc_recola_register_processes
	<<Prc recola: procedures>>=
	module subroutine prc_recola_register_processes (writer, recola_ids)
	class(recola_writer_t), intent(in) :: writer
	integer, dimension (:), intent(inout) :: recola_ids
	integer :: recola_id
	integer :: i_flv
	integer :: n_tot
	integer :: unit, iostat
	integer, dimension(:), allocatable :: pdg
	type(string_t), dimension(:), allocatable :: particle_names
	type(string_t) :: process_string
	integer :: i_part
	!!! TODO (cw-2016-08-08): Include helicities
	call msg_message ("Recola: registering processes for '" // char (writer%id) // "'")
	i_flv = 0
	n_tot = writer%n_in + writer%n_out
	allocate (pdg (n_tot))
	allocate (particle_names (n_tot))
	call open_flv_list (writer%id, unit)
	call rclwrap_request_generate_processes ()
	SCAN_FLV_LIST: do
	read (unit, *, iostat = iostat) pdg
	if (iostat < 0) then
	exit SCAN_FLV_LIST
	else if (iostat > 0) then
	call err_flv_list (writer%id)
	end if
	i_flv = i_flv + 1
	call rclwrap_get_new_recola_id (recola_id)
	recola_ids(i_flv) = recola_id
	particle_names(:) = get_recola_particle_string (pdg)
	process_string = var_str ("")
	do i_part = 1, n_tot
	process_string = process_string // &
	particle_names (i_part) // var_str (" ")
	if (i_part == writer%n_in) then
	process_string = process_string // var_str ("-> ")
	end if
	end do
	call msg_message ("Recola: " &
	// "process #" // char (str (recola_id)) &
	// ": " // char (process_string) &
	// "(" // char (writer%order) // ")")
	call rclwrap_add_process (recola_id, process_string, writer%order)
	call rclwrap_define_processes ()
	end do SCAN_FLV_LIST
	call close_flv_list (unit)
	if (debug_on) call msg_debug (D_ME_METHODS, "RECOLA: processes for '" &
	// char (writer%id) // "' registered")
	end subroutine prc_recola_register_processes

	@ %def prc_recola_register_processes
	@ Manage the list of flavor combinations for the current process. We rely on
	this being created along with the \oMega\ call.
	<<Prc recola: procedures>>=
	subroutine open_flv_list (id, unit)
	type(string_t), intent(in) :: id
	integer, intent(out) :: unit
	type(string_t) :: flv_file
	integer :: iostat
	flv_file = flv_file_name (id)
	open (file = char (flv_file), newunit = unit, &
	status = "old", action = "read", &
	iostat = iostat)
	if (iostat /= 0) then
	call msg_fatal ("Recola: attempt to open flavor-list file '" &
	// char (flv_file) // "' failed")
	end if
	end subroutine open_flv_list

	subroutine err_flv_list (id)
	type(string_t), intent(in) :: id
	type(string_t) :: flv_file
	flv_file = flv_file_name (id)
	call msg_fatal ("Recola: error while reading from flavor-list file '" &
	// char (flv_file) // "'")
	end subroutine err_flv_list

	subroutine close_flv_list (unit)
	integer, intent(in) :: unit
	close (unit)
	end subroutine close_flv_list

	@ %def open_flv_list
	@ %def err_flv_list
	@ %def close_flv_list
	@
	\subsection{Driver object}
	A core driver is required by design. However, we are not going to
	load any external dynamical libraries, so this is a dummy.
	<<Prc recola: types>>=
	type, extends (prc_external_driver_t) :: recola_driver_t
	contains
	<<Prc recola: recola driver: TBP>>
	end type recola_driver_t

	@ %def recola_driver_t
	@ Gfortran 7/8/9 bug: has to remain in the main module.
	<<Prc recola: recola def: TBP>>=
	procedure :: allocate_driver => recola_def_allocate_driver
	<<Prc recola: main procedures>>=
	subroutine recola_def_allocate_driver (object, driver, basename)
	class(recola_def_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	if (debug_on) call msg_debug2 (D_ME_METHODS, "recola_def_allocate_driver")
	allocate (recola_driver_t :: driver)
	end subroutine recola_def_allocate_driver

	@ %def recola_def_allocate_driver
	@
	<<Prc recola: recola driver: TBP>>=
	procedure, nopass :: type_name => recola_driver_type_name
	<<Prc recola: sub interfaces>>=
	module function recola_driver_type_name () result (type)
	type(string_t) :: type
	end function recola_driver_type_name
	<<Prc recola: procedures>>=
	module function recola_driver_type_name () result (type)
	type(string_t) :: type
	type = "Recola"
	end function recola_driver_type_name

	@ %def recola_driver_type_name
	@
	\subsection{Process object}
	We create [[prc_recola_t]] as an extension of the [[prc_external_t]],
	which in turn inherits from [[prc_core_t]]. This way, we can use a lot of the
	existing interfaces in the actual code. However, we have to stick to the rules and
	implement the deferred type-bound procedures of [[prc_core_t]].
	<<Prc recola: public>>=
	public :: prc_recola_t
	<<Prc recola: types>>=
	type, extends (prc_external_t) :: prc_recola_t
	integer, dimension(:), allocatable :: recola_ids
	integer, dimension(:,:), allocatable :: color_state
	integer :: n_f = 0
	logical :: helicity_and_color_arrays_are_replaced = .false.
	contains
	<<Prc recola: prc recola: TBP>>
	end type prc_recola_t

	@ %def prc_recola_t
	@
	<<Prc recola: prc recola: TBP>>=
	procedure :: write_name => prc_recola_write_name
	<<Prc recola: sub interfaces>>=
	module subroutine prc_recola_write_name (object, unit)
	class(prc_recola_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_recola_write_name
	<<Prc recola: procedures>>=
	module subroutine prc_recola_write_name (object, unit)
	class(prc_recola_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u,"(1x,A)") "Core: Recola"
	end subroutine prc_recola_write_name

	@ %def prc_recola_write_name
	@
	<<Prc recola: prc recola: TBP>>=
	procedure :: has_matrix_element => prc_recola_has_matrix_element
	<<Prc recola: sub interfaces>>=
	module function prc_recola_has_matrix_element (object) result (flag)
	logical :: flag
	class(prc_recola_t), intent(in) :: object
	end function prc_recola_has_matrix_element
	<<Prc recola: procedures>>=
	module function prc_recola_has_matrix_element (object) result (flag)
	logical :: flag
	class(prc_recola_t), intent(in) :: object
	flag = .true.
	end function prc_recola_has_matrix_element

	@ %def prc_recola_has_matrix_element
	@
	Not implemented yet.
	<<Prc recola: prc recola: TBP>>=
	procedure :: write => prc_recola_write
	<<Prc recola: sub interfaces>>=
	module subroutine prc_recola_write (object, unit)
	class(prc_recola_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_recola_write
	<<Prc recola: procedures>>=
	module subroutine prc_recola_write (object, unit)
	class(prc_recola_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_recola_write

	@ %def prc_recola_write
	@
	\subsection{Accompanying state object}
	This must be implemented, but is unused.
	<<Prc recola: types>>=
	type, extends (prc_external_state_t) :: recola_state_t
	contains
	<<Prc recola: recola state: TBP>>
	end type recola_state_t

	@ %def recola_state_t
	@
	<<Prc recola: recola state: TBP>>=
	procedure :: write => recola_state_write
	<<Prc recola: sub interfaces>>=
	module subroutine recola_state_write (object, unit)
	class(recola_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine recola_state_write
	<<Prc recola: procedures>>=
	module subroutine recola_state_write (object, unit)
	class(recola_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine recola_state_write

	@ %def recola_state_write
	@ Gfortran 7/8/9 bug: has to remain in the main module.
	<<Prc recola: prc recola: TBP>>=
	procedure :: allocate_workspace => prc_recola_allocate_workspace
	<<Prc recola: main procedures>>=
	subroutine prc_recola_allocate_workspace (object, core_state)
	class(prc_recola_t), intent(in) :: object
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	allocate (recola_state_t :: core_state)
	end subroutine prc_recola_allocate_workspace

	@ %def prc_recola_allocate_workspace
	@
	\subsection{Recola process data}
	This information is stored in the associated [[def]] object. To
	obtain it, we need a type cast.
	<<Prc recola: prc recola: TBP>>=
	procedure :: get_alpha_power => prc_recola_get_alpha_power
	procedure :: get_alphas_power => prc_recola_get_alphas_power
	<<Prc recola: sub interfaces>>=
	module function prc_recola_get_alpha_power (object) result (p)
	class(prc_recola_t), intent(in) :: object
	integer :: p
	end function prc_recola_get_alpha_power
	module function prc_recola_get_alphas_power (object) result (p)
	class(prc_recola_t), intent(in) :: object
	integer :: p
	end function prc_recola_get_alphas_power
	<<Prc recola: procedures>>=
	module function prc_recola_get_alpha_power (object) result (p)
	class(prc_recola_t), intent(in) :: object
	integer :: p
	p = 0
	if (associated (object%def)) then
	select type (def => object%def)
	type is (recola_def_t)
	p = def%alpha_power
	end select
	end if
	end function prc_recola_get_alpha_power

	module function prc_recola_get_alphas_power (object) result (p)
	class(prc_recola_t), intent(in) :: object
	integer :: p
	p = 0
	if (associated (object%def)) then
	select type (def => object%def)
	type is (recola_def_t)
	p = def%alphas_power
	end select
	end if
	end function prc_recola_get_alphas_power

	@ %def prc_recola_get_alpha_power
	@ %def prc_recola_get_alphas_power
	@
	<<Prc recola: prc recola: TBP>>=
	procedure :: compute_alpha_s => prc_recola_compute_alpha_s
	<<Prc recola: sub interfaces>>=
	module subroutine prc_recola_compute_alpha_s (object, core_state, ren_scale)
	class(prc_recola_t), intent(in) :: object
	class(prc_external_state_t), intent(inout) :: core_state
	real(default), intent(in) :: ren_scale
	end subroutine prc_recola_compute_alpha_s
	<<Prc recola: procedures>>=
	module subroutine prc_recola_compute_alpha_s (object, core_state, ren_scale)
	class(prc_recola_t), intent(in) :: object
	class(prc_external_state_t), intent(inout) :: core_state
	real(default), intent(in) :: ren_scale
	core_state%alpha_qcd = object%qcd%alpha%get (ren_scale)
	end subroutine prc_recola_compute_alpha_s

	@ %def prc_recola_compute_alpha_s
	@
	<<Prc recola: prc recola: TBP>>=
	procedure :: includes_polarization => prc_recola_includes_polarization
	<<Prc recola: sub interfaces>>=
	module function prc_recola_includes_polarization (object) result (polarized)
	logical :: polarized
	class(prc_recola_t), intent(in) :: object
	end function prc_recola_includes_polarization
	<<Prc recola: procedures>>=
	module function prc_recola_includes_polarization (object) result (polarized)
	logical :: polarized
	class(prc_recola_t), intent(in) :: object
	polarized = .false.
	end function prc_recola_includes_polarization

	@ %def prc_recola_includes_polarization
	@
	\subsection{Prepare for process evaluation}
	This has become obsolete and is empty.
	<<Prc recola: prc recola: TBP>>=
	procedure :: prepare_external_code => &
	prc_recola_prepare_external_code
	<<Prc recola: sub interfaces>>=
	module subroutine prc_recola_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_recola_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	end subroutine prc_recola_prepare_external_code
	<<Prc recola: procedures>>=
	module subroutine prc_recola_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_recola_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	if (debug_on) call msg_debug &
	(D_ME_METHODS, "prc_recola_prepare_external_code (no-op)")
	end subroutine prc_recola_prepare_external_code

	@ %def prc_recola_prepare_external_code
	@
	Set all Recola parameters to their correct values. We use the model
	object for masses and such. Note that the QCD object provides the
	[[n_f]] parameter which affects $\alpha_s$ evaluation.

	Note that this is executed before the [[init]] method below, which
	defines and prepares the Recola process objects. This is in line with
	the Recola workflow, however.
	<<Prc recola: prc recola: TBP>>=
	procedure :: set_parameters => prc_recola_set_parameters
	<<Prc recola: sub interfaces>>=
	module subroutine prc_recola_set_parameters (object, qcd, model)
	class(prc_recola_t), intent(inout) :: object
	type(qcd_t), intent(in) :: qcd
	class(model_data_t), intent(in), target, optional :: model
	end subroutine prc_recola_set_parameters
	<<Prc recola: procedures>>=
	module subroutine prc_recola_set_parameters (object, qcd, model)
	class(prc_recola_t), intent(inout) :: object
	type(qcd_t), intent(in) :: qcd
	class(model_data_t), intent(in), target, optional :: model

	if (debug_on) call msg_debug (D_ME_METHODS, "RECOLA: set_parameters")
	object%qcd = qcd
	call rclwrap_set_dynamic_settings ()
	call rclwrap_set_pole_mass &
	(11, dble(model%get_real (var_str ('me'))), 0._double)
	call rclwrap_set_pole_mass &
	(13, dble(model%get_real (var_str ('mmu'))), 0._double)
	call rclwrap_set_pole_mass &
	(15, dble(model%get_real (var_str ('mtau'))), 0._double)

	call rclwrap_set_pole_mass (1, 0._double, 0._double)
	call rclwrap_set_pole_mass (2, 0._double, 0._double)

	call rclwrap_set_pole_mass (3, dble(model%get_real (var_str ('ms'))), 0._double)
	call rclwrap_set_pole_mass (4, dble(model%get_real (var_str ('mc'))), 0._double)
	call rclwrap_set_pole_mass (5, dble(model%get_real (var_str ('mb'))), 0._double)
	call rclwrap_set_pole_mass (6, dble(model%get_real (var_str ('mtop'))), &
	dble(model%get_real (var_str ('wtop'))))

	call rclwrap_set_pole_mass (23, dble(model%get_real (var_str ('mZ'))), &
	dble(model%get_real (var_str ('wZ'))))
	call rclwrap_set_pole_mass (24, dble(model%get_real (var_str ('mW'))), &
	dble(model%get_real (var_str ('wW'))))
	call rclwrap_set_pole_mass (25, dble(model%get_real (var_str ('mH'))), &
	dble(model%get_real (var_str ('wH'))))

	!!! TODO PB 03-03-2022: Automatize EW input schemes
	call rclwrap_use_gfermi_scheme (dble(model%get_real (var_str ('GF'))))
	!!! TODO PB 03-03-2022: Automatize mass threshold for light fermions
	call rclwrap_set_light_fermions (0._double)
	call rclwrap_set_delta_ir (0._double, dble(pi**2 / 6))
	end subroutine prc_recola_set_parameters

	@ %def prc_recola_set_parameters
	@
	<<XXX prc recola: prc recola: TBP>>=
	procedure :: set_mu_ir => prc_recola_set_mu_ir
	<<XXX prc recola: procedures>>=
	subroutine prc_recola_set_mu_ir (object, mu)
	class(prc_recola_t), intent(inout) :: object
	real(default), intent(in) :: mu
	call rclwrap_set_mu_ir (dble(mu))
	end subroutine prc_recola_set_mu_ir

	@ %def prc_recola_set_mu_ir
	@
	Extend the base-type initialization method by Recola-specific
	initialization.

	We take the process definitions from the [[def]] object, which has
	been filled before. The [[writer]] component of the
	process-definition object can now complete its task and prepare the
	Recola processes.

	Sadly, we have to completely reset Recola first, since Recola does not
	allow to modify \emph{anything} after process definition. Also, we
	cannot really make use of Recola's multi-process capability without
	violating the Whizard convention that the parameter settings at
	process integration time apply, not at process definition time. Each
	new process (i.e., process-integration) object will thus trigger a complete
	new Recola instance.
	<<Prc recola: prc recola: TBP>>=
	procedure :: init => prc_recola_init
	<<Prc recola: sub interfaces>>=
	module subroutine prc_recola_init (object, def, lib, id, i_component)
	class(prc_recola_t), intent(inout) :: object
	class(prc_core_def_t), intent(in), target :: def
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	end subroutine prc_recola_init
	<<Prc recola: procedures>>=
	module subroutine prc_recola_init (object, def, lib, id, i_component)
	class(prc_recola_t), intent(inout) :: object
	class(prc_core_def_t), intent(in), target :: def
	type(process_library_t), intent(in), target :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	integer :: n_flv
	if (debug_on) call msg_debug (D_ME_METHODS, "RECOLA: init process object")
	call object%base_init (def, lib, id, i_component)
	n_flv = size (object%data%flv_state, 2)
	allocate (object%recola_ids(n_flv))
	select type (writer => object%def%writer)
	type is (recola_writer_t)
	call writer%register_processes (object%recola_ids)
	end select
	call rclwrap_generate_processes ()
	call object%replace_helicity_and_color_arrays ()
	end subroutine prc_recola_init

	@ %def prc_recola_init
	@ Recola can compute dressed amplitudes, but it needs helicity and color
	to be in its own format to do so.
	<<Prc recola: prc recola: TBP>>=
	procedure :: replace_helicity_and_color_arrays => &
	prc_recola_replace_helicity_and_color_arrays
	<<Prc recola: sub interfaces>>=
	module subroutine prc_recola_replace_helicity_and_color_arrays (object)
	class(prc_recola_t), intent(inout) :: object
	end subroutine prc_recola_replace_helicity_and_color_arrays
	<<Prc recola: procedures>>=
	module subroutine prc_recola_replace_helicity_and_color_arrays (object)
	class(prc_recola_t), intent(inout) :: object
	integer, dimension(:,:), allocatable :: col_recola
	integer :: i
	if (debug_on) call msg_debug &
	(D_ME_METHODS, "RECOLA: replace_helicity_and_color_arrays")
	deallocate (object%data%hel_state)
	call rclwrap_get_helicity_configurations &
	(object%recola_ids(1), object%data%hel_state)
	call rclwrap_get_color_configurations (object%recola_ids(1), col_recola)
	allocate (object%color_state (object%data%n_in + object%data%n_out, &
	size (col_recola, dim = 2)))
	do i = 1, size (col_recola, dim = 2)
	object%color_state (:, i) = col_recola (:, i)
	end do
	end subroutine prc_recola_replace_helicity_and_color_arrays

	@ %def prc_recola_replace_helicity_and_color_arrays
	@
	\subsection{Compute matrix element}
	Computes the amplitude as a function of the phase space point, the
	flavor, helicity and color index. It is currently only used in the form
	by [[prc_omega_t]], all the other ones use different interfaces. H

	With RECOLA, we might be able to use this, too. The current
	implementation can fail due to missing helicity initialization.
	<<Prc recola: prc recola: TBP>>=
	procedure :: compute_amplitude => prc_recola_compute_amplitude
	<<Prc recola: sub interfaces>>=
	module function prc_recola_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	complex(default) :: amp
	class(prc_recola_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: &
	core_state
	end function prc_recola_compute_amplitude
	<<Prc recola: procedures>>=
	module function prc_recola_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	complex(default) :: amp
	class(prc_recola_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: &
	core_state
	real(double), dimension(0:3, object%data%n_in + object%data%n_out) :: &
	p_recola
	integer :: i
	logical :: new_event
	complex(double) :: amp_dble

	if (debug_on) call msg_debug2 (D_ME_METHODS, "prc_recola_compute_amplitude")
	if (present (core_state)) then
	if (allocated (core_state)) then
	select type (core_state)
	type is (recola_state_t)
	new_event = core_state%new_kinematics
	core_state%new_kinematics = .false.
	end select
	end if
	end if
	if (new_event) then
	do i = 1, object%data%n_in + object%data%n_out
	p_recola(:, i) = dble(p(i)%p)
	end do
	call rclwrap_compute_process (object%recola_ids(f), p_recola, 'LO')
	end if
	call rclwrap_get_amplitude (object%recola_ids(f), 0, 'LO', &
	object%color_state (:, c), object%data%hel_state (h, :), amp_dble)
	amp = amp_dble
	end function prc_recola_compute_amplitude

	@ %def prc_recola_compute_amplitude
	@
	<<Prc recola: prc recola: TBP>>=
	procedure :: compute_sqme => prc_recola_compute_sqme
	<<Prc recola: sub interfaces>>=
	module subroutine prc_recola_compute_sqme (object, i_flv, i_hel, p, &
	ren_scale, sqme, bad_point)
	class(prc_recola_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out) :: sqme
	logical, intent(out) :: bad_point
	end subroutine prc_recola_compute_sqme
	<<Prc recola: procedures>>=
	module subroutine prc_recola_compute_sqme (object, i_flv, i_hel, p, &
	ren_scale, sqme, bad_point)
	class(prc_recola_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out) :: sqme
	logical, intent(out) :: bad_point
	real(double) :: sqme_dble
	real(double), dimension(0:3, object%data%n_in + object%data%n_out) :: &
	p_recola
	real(default) :: alpha_s
	integer :: i
	integer :: alphas_power
	! TODO sbrass: Helicity for RECOLA
	if (debug_on) call msg_debug2 (D_ME_METHODS, "prc_recola_compute_sqme")
	do i = 1, object%data%n_in + object%data%n_out
	p_recola(:, i) = dble(p(i)%p)
	end do
	alpha_s = object%qcd%alpha%get (ren_scale)
	if (debug_on) call msg_debug2 (D_ME_METHODS, "alpha_s", alpha_s)
	if (debug_on) call msg_debug2 (D_ME_METHODS, "ren_scale", ren_scale)
	call rclwrap_set_alpha_s (dble (alpha_s), dble (ren_scale), object%qcd%n_f)
	call rclwrap_set_mu_ir (dble (ren_scale))
	call rclwrap_compute_process (object%recola_ids(i_flv), p_recola, 'LO')
	call rclwrap_get_squared_amplitude &
	(object%recola_ids(i_flv), object%get_alphas_power (), 'LO', sqme_dble)
	sqme = real(sqme_dble, kind=default)
	bad_point = .false.
	end subroutine prc_recola_compute_sqme

	@ %def prc_recola_compute_sqme
	@
	<<Prc recola: prc recola: TBP>>=
	procedure :: compute_sqme_virt => prc_recola_compute_sqme_virt
	<<Prc recola: sub interfaces>>=
	module subroutine prc_recola_compute_sqme_virt (object, i_flv, i_hel, &
	p, ren_scale, es_scale, loop_method, sqme, bad_point)
	class(prc_recola_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale, es_scale
	integer, intent(in) :: loop_method
	real(default), dimension(4), intent(out) :: sqme
	real(default) :: amp
	logical, intent(out) :: bad_point
	end subroutine prc_recola_compute_sqme_virt
	<<Prc recola: procedures>>=
	module subroutine prc_recola_compute_sqme_virt (object, i_flv, i_hel, &
	p, ren_scale, es_scale, loop_method, sqme, bad_point)
	class(prc_recola_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale, es_scale
	integer, intent(in) :: loop_method
	real(default), dimension(4), intent(out) :: sqme
	real(default) :: amp
	logical, intent(out) :: bad_point
	real(double), dimension(0:3, object%data%n_in + object%data%n_out) :: &
	p_recola
	real(double) :: sqme_dble
	real(default) :: alpha_s
	integer :: i, as_coupling_power
	logical :: ew_corr
	! TODO sbrass Helicity for RECOLA
	if (debug_on) call msg_debug2 (D_ME_METHODS, "prc_recola_compute_sqme_virt")
	sqme = zero
	do i = 1, object%data%n_in + object%data%n_out
	p_recola(:, i) = dble(p(i)%p)
	end do
	call rclwrap_set_mu_ir (dble (ren_scale))
	alpha_s = object%qcd%alpha%get (ren_scale)
	call rclwrap_set_alpha_s (dble (alpha_s), dble (ren_scale), object%qcd%n_f)
	call rclwrap_compute_process (object%recola_ids(i_flv), p_recola, 'NLO')
	if (associated (object%def)) then
	select type (def => object%def)
	type is (recola_def_t)
	ew_corr = def%corr == RECOLA_EW
	end select
	end if
	if (ew_corr) then
	as_coupling_power = object%get_alphas_power ()
	else
	as_coupling_power = object%get_alphas_power () + 1
	end if
	call rclwrap_get_squared_amplitude (object%recola_ids(i_flv), &
	as_coupling_power, 'NLO', sqme_dble)
	sqme(3) = sqme_dble
	call rclwrap_get_squared_amplitude &
	(object%recola_ids(i_flv), object%get_alphas_power (), 'LO', sqme_dble)
	sqme(4) = sqme_dble
	bad_point = .false.
	end subroutine prc_recola_compute_sqme_virt

	@ %def prc_recola_compute_sqme_virt
	@
	<<Prc recola: prc recola: TBP>>=
	procedure :: get_alpha_qed => prc_recola_get_alpha_qed
	<<Prc recola: sub interfaces>>=
	module function prc_recola_get_alpha_qed &
	(object, core_state) result (alpha_qed)
	class(prc_recola_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qed
	end function prc_recola_get_alpha_qed
	<<Prc recola: procedures>>=
	module function prc_recola_get_alpha_qed &
	(object, core_state) result (alpha_qed)
	class(prc_recola_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(double) :: value
	real(default) :: alpha_qed
	alpha_qed = rclwrap_get_alpha ()
	end function prc_recola_get_alpha_qed

	@ %def prc_recola_get_alpha_qed
	@ For RECOLA, explicit color factors need to multiplied to the
	off-diagonal elements of the color correlation matrix. The factor 1/2
	from the normalization accoring to the RECOLA manual is covered by the
	fact that we are taking only one half of the symmetric matrix.
	<<Prc recola: prc recola: TBP>>=
	procedure :: compute_sqme_color_c_raw => prc_recola_compute_sqme_color_c_raw
	<<Prc recola: sub interfaces>>=
	module subroutine prc_recola_compute_sqme_color_c_raw (object, &
	i_flv, i_hel, p, ren_scale, sqme_color_c, bad_point)
	class(prc_recola_t), intent(in) :: object
	integer, intent(in) :: i_hel, i_flv
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale
	real(default), dimension(:), intent(out) :: sqme_color_c
	logical, intent(out) :: bad_point
	end subroutine prc_recola_compute_sqme_color_c_raw
	<<Prc recola: procedures>>=
	module subroutine prc_recola_compute_sqme_color_c_raw (object, &
	i_flv, i_hel, p, ren_scale, sqme_color_c, bad_point)
	class(prc_recola_t), intent(in) :: object
	integer, intent(in) :: i_hel, i_flv
	type(vector4_t), dimension(:), intent(in) :: p
	real(double), dimension(0:3, object%data%n_in + object%data%n_out) :: &
	p_recola
	real(default), intent(in) :: ren_scale
	real(default), dimension(:), intent(out) :: sqme_color_c
	logical, intent(out) :: bad_point
	integer :: i1, i2, i, n_tot
	real(double) :: sqme_dble
	do i = 1, object%data%n_in + object%data%n_out
	p_recola(:, i) = dble(p(i)%p)
	end do
	n_tot = object%data%n_in + object%data%n_out
	i = 0
	do i1 = 1, n_tot
	do i2 = 1, i1-1
	i = i + 1
	call rclwrap_compute_color_correlation &
	(object%recola_ids(i_flv), p_recola, i1, i2, sqme_dble)
	sqme_color_c(i) = real (sqme_dble, kind=default)
	select case (abs (object%data%flv_state (i1, i_flv)))
	case (1:6)
	sqme_color_c(i) = CF * sqme_color_c(i)
	case (9,21)
	sqme_color_c(i) = CA * sqme_color_c(i)
	end select
	end do
	end do
	end subroutine prc_recola_compute_sqme_color_c_raw

	@ %def prc_recola_compute_sqme_color_c_raw
	@
	\subsection{Unit tests}
	<<[[prc_recola_ut.f90]]>>=
	<<File header>>

	module prc_recola_ut
	use unit_tests
	use prc_recola_uti

	<<Standard module head>>

	<<Prc recola: public tests>>

	contains

	<<Prc recola: test driver>>

	end module prc_recola_ut
	@ %def prc_recola_ut
	@
	<<[[prc_recola_uti.f90]]>>=
	<<File header>>

	module prc_recola_uti

	use recola_wrapper !NODEP!

	use, intrinsic :: iso_c_binding !NODEP!
	use kinds
	<<Use strings>>

	use constants
	use format_utils, only: write_separator
	use numeric_utils, only: assert_equal
	use os_interface
	use particle_specifiers, only: new_prt_spec
	use prc_core_def
	use process_constants
	use process_libraries
	use prc_core
	use prc_omega

	<<Standard module head>>

	<<Prc recola: test declarations>>

	contains

	<<Prc recola: test procedures>>

	<<Prc recola: tests>>

	end module prc_recola_uti

	@ %def prc_recola_uti
	@
	<<Prc recola: public tests>>=
	public :: prc_recola_test
	<<Prc recola: test driver>>=
	subroutine prc_recola_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Prc recola: execute tests>>
	end subroutine prc_recola_test

	@ %def prc_recola_test
	@
	\subsubsection{Testing a fixed flavor matrix element computation}
	<<Prc recola: test procedures>>=
	function get_omega_parameter_array () result (par)
	real(default), dimension(25) :: par
	par = zero

	par(1) = 1.16637d-5 ! gf
	par(2) = 91.153480619182744_default ! mZ
	par(3) = 80.357973609877547_default ! mW
	par(4) = 125._default ! mH
	par(5) = rclwrap_get_alpha_s () ! alpha_s
	par(12) = 173.2_default ! mt
	par(14) = 2.4942663787728243_default ! wZ
	par(15) = 2.0842989982782196_default ! wW
	par(22) = one / sqrt (sqrt (two) * par(1)) ! par%v - Higgs expectation value
	par(23) = par(3) / par(2) ! par%cw
	par(24) = sqrt (one - par(23)**2) ! par%sw
	par(25) = two * par(24) * par(3) / par(22)
	end function get_omega_parameter_array

	@ %def get_omega_parameter_array
	@
	<<Prc recola: execute tests>>=
	call test (prc_recola_1, "prc_recola_1", &
	"Registering a RECOLA process and computing the amplitude", &
	u, results)
	<<Prc recola: test declarations>>=
	public :: prc_recola_1
	<<Prc recola: tests>>=
	subroutine prc_recola_1 (u)
	integer, intent(in) :: u
	real(double) :: p(0:3,1:4)
	real(double) :: sqrts = 500._double
	real(double) :: m_e = 0._double
	real(double) :: m_mu = 0._double
	real(double) :: p_x_out, p_y_out, p_z_out, p_z_in
	integer :: h_e_p, h_e_m, h_mu_p, h_mu_m, counter
	real(double) :: sqme
	integer :: i
	integer, dimension(:), allocatable :: col_recola, hel_recola
	complex(double) :: amp_recola
	complex(default) :: amp_recola_default

	real(default), parameter :: ee = 0.3 !!! Electromagnetic coupling

	type(process_library_t) :: lib
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(os_data_t) :: os_data
	type(process_constants_t) :: data
	class(prc_core_driver_t), allocatable :: driver
	complex(default) :: amp

	integer, dimension(:,:), allocatable :: helicities



	write (u, "(A)") "* Test output: prc_recola_1"
	write (u, "(A)") "* Purpose: Test interface to RECOLA and compare matrix elements with O'Mega"
	write (u, "(A)")

	p_z_in = sqrt ((sqrts / 2)2 - m_e2)
	p_z_out = 0._double
	p_y_out = sqrts / 10._default
	p_x_out = sqrt ((sqrts / 2)2 - p_y_out2 - p_z_out2 - m_mu2)
	p(:,1) = [sqrts / 2, 0._double, 0._double, p_z_in]
	p(:,2) = [sqrts / 2, 0._double, 0._double, -p_z_in]
	p(:,3) = [sqrts / 2, p_x_out, p_y_out, p_z_out]
	p(:,4) = [sqrts / 2, -p_x_out, -p_y_out, -p_z_out]

	write (u, "(A)") "Use phase-space point: "
	do i = 1, 4
	write (u, "(4(F12.3,1x))") p(:,1)
	end do
	write (u, "(A)")
	call write_separator (u)
	write (u, "(A)")
	write (u, "(A)") "* RECOLA: Evaluate process"
	counter = 1
	call rclwrap_request_generate_processes ()
	write (u, "(A)") "* RECOLA: Define process e+ e- -> mu+ mu- at leading order"
	call rclwrap_add_process (counter, var_str ('e+ e- -> mu+ mu-'), var_str ('LO'))
	call rclwrap_define_processes ()
	write (u, "(A)") "* RECOLA: generate process"
	call rclwrap_generate_processes ()
	call rclwrap_compute_process (1, p, 'LO')
	call rclwrap_get_helicity_configurations (1, helicities)
	allocate (hel_recola (4), col_recola (4))
	col_recola = [0,0,0,0]

	write (u, "(A)") "* Setting up Omega to compute the same amplitude"

	call lib%init (var_str ("omega1"))
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("mu+"), var_str ("mu-")]

	allocate (omega_def_t :: def)
	select type (def)
	type is (omega_def_t)
	call def%init (var_str ("SM"), prt_in, prt_out, &
	ufo = .false., ovm = .false., cms_scheme = .true.)
	end select

	allocate (entry)
	call entry%init (var_str ("omega1_a"), model_name = var_str ("SM"), &
	n_in = 2, n_components = 1)
	call entry%import_component (1, n_out = 2, &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("omega"), &
	variant = def)
	call lib%append (entry)

	call os_data%init ()
	call lib%configure (os_data)
	call lib%write_makefile (os_data, force = .true., verbose = .false.)
	call lib%clean (os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (os_data)
	call lib%connect_process (var_str ("omega1_a"), 1, data, driver)

	select type (driver)
	type is (omega_driver_t)
	call driver%init (get_omega_parameter_array (), 3)
	call driver%new_event (real(p, kind = default))
	do i = 1, 6
	call rclwrap_get_amplitude (1, 0, 'LO', col_recola, helicities (:,i), amp_recola)
	end do
	do i = 1, 16
	call rclwrap_get_amplitude (1, 0, 'LO', col_recola, data%hel_state (:,i), amp_recola)
	amp_recola = amp_recola * cmplx (0, -1, double)
	amp_recola_default = amp_recola
	call driver%get_amplitude (1, i, 1, amp)
	write(u,"(A,4(I2),A)") "Helicity: [",data%hel_state (:,i),"]"
	call assert_equal (u, amp, amp_recola_default, rel_smallness = 1.E-7_default)
	end do

	end select

	call rclwrap_reset_recola ()

	write (u, "(A)")
	write (u, "(A)") "* End of test output: prc_recola_1"

	end subroutine prc_recola_1

	@ %def prc_recola_1
	@
	\subsubsection{Testing a fixed flavor matrix element computation for 2->3}
	<<Prc recola: execute tests>>=
	call test (prc_recola_2, "prc_recola_2", &
	"Registering a RECOLA process and computing the amplitude for 2->3 process", &
	u, results)
	<<Prc recola: test declarations>>=
	public :: prc_recola_2
	<<Prc recola: tests>>=
	subroutine prc_recola_2 (u)
	integer, intent(in) :: u
	real(double) :: p(0:3,1:5)
	real(double) :: sqrts = 700._double
	real(double) :: m_e = 0._double
	real(double) :: m_mu = 0._double
	real(double) :: p_x_out, p_y_out, p_z_out, p_z_in
	real(double) :: sqme
	integer :: i
	integer, dimension(:), allocatable :: col_recola, hel_recola
	integer, dimension(:,:), allocatable :: helicities
	complex(double) :: amp_recola
	complex(default) :: amp_recola_default

	real(default), parameter :: ee = 0.3 !!! Electromagnetic coupling

	type(process_library_t) :: lib
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(os_data_t) :: os_data
	type(process_constants_t) :: data
	class(prc_core_driver_t), allocatable :: driver
	complex(default) :: amp
	integer :: n_allowed

	write (u, "(A)") "* Test output: prc_recola_2"
	write (u, "(A)") "* Purpose: Test interface to RECOLA and compare matrix elements with O'Mega for 2->3 process"
	write (u, "(A)")

	p_z_in = sqrt ((sqrts / 2)2 - m_e2)
	p(:,1) = [sqrts / 2, 0._double, 0._double, p_z_in]
	p(:,2) = [sqrts / 2, 0._double, 0._double, -p_z_in]
	p(:,3) = [243.49323116_double, -141.69619338_double, -108.30640321_double, 165.77353656_double]
	p(:,4) = [337.53250628_double, 143.95931207_double, 110.19717026_double, -284.71124482_double]
	p(:,5) = [118.97426257_double, -2.2631186860_double, -1.8907670459_double, 118.93770827_double]

	write (u, "(A)") "Use phase-space point: "
	do i = 1, 5
	write (u, "(4(F12.3,1x))") p(:,1)
	end do
	write (u, "(A)")
	call write_separator (u)
	write (u, "(A)")
	write (u, "(A)") "* RECOLA: Evaluate process"
	call rclwrap_request_generate_processes ()
	write (u, "(A)") "* RECOLA: Define process e+ e- -> mu+ mu- A at leading order"
	call rclwrap_add_process (2, var_str ('e+ e- -> mu+ mu- A'), var_str ('LO'))
	call rclwrap_define_processes ()
	write (u, "(A)") "* RECOLA: generate process"
	call rclwrap_generate_processes ()
	call rclwrap_compute_process (2, p, 'LO')
	call rclwrap_get_helicity_configurations (2, helicities)

	allocate (hel_recola (5), col_recola (5))
	col_recola = [0,0,0,0,0]


	write (u, "(A)") "* Setting up Omega to compute the same amplitude"

	call lib%init (var_str ("omega2"))
	allocate (prt_in (2), prt_out (3))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("mu+"), var_str ("mu-"), var_str("A")]

	allocate (omega_def_t :: def)
	select type (def)
	type is (omega_def_t)
	call def%init (var_str ("SM"), prt_in, prt_out, &
	ufo = .false., ovm = .false.)
	end select

	allocate (entry)
	call entry%init (var_str ("omega2_a"), model_name = var_str ("SM"), &
	n_in = 2, n_components = 1)
	call entry%import_component (1, n_out = 3, &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("omega"), &
	variant = def)
	call lib%append (entry)

	call os_data%init ()
	call lib%configure (os_data)
	call lib%write_makefile (os_data, force = .true., verbose = .false.)
	call lib%clean (os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (os_data)
	call lib%connect_process (var_str ("omega2_a"), 1, data, driver)


	select type (driver)
	type is (omega_driver_t)
	call driver%init (get_omega_parameter_array (), 3)
	call driver%new_event (real(p, kind = default))
	do i = 1, 32
	call rclwrap_get_amplitude &
	(2, 0, 'LO', col_recola, data%hel_state (:,i), amp_recola)
	if (data%hel_state(3,i) * data%hel_state(4,i) * &
	data%hel_state(5,i) == -1) then
	amp_recola = amp_recola * cmplx (0, -1, double)
	else
	amp_recola = amp_recola * cmplx (0, 1, double)
	end if
	amp_recola_default = amp_recola
	call driver%get_amplitude (1, i, 1, amp)
	write(u,"(A,5(I2),A)") "Helicity: [", data%hel_state (:,i),"]"
	write(u,"(A,2(F12.7,1x),A,2(F12.7,1x))") "RECOLA:", &
	amp_recola,", O'MEGA:", amp
	call assert_equal &
	(u, amp, amp_recola_default, rel_smallness = 1.E-6_default)
	end do

	end select

	call rclwrap_reset_recola ()

	write (u, "(A)")
	write (u, "(A)") "* End of test output: prc_recola_2"

	end subroutine prc_recola_2
	@ %def prc_recola_2
	@
	Index: trunk/src/blha/blha.nw
	===================================================================
	--- trunk/src/blha/blha.nw (revision 8903)
	+++ trunk/src/blha/blha.nw (revision 8904)
	@@ -1,4300 +1,4358 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: matrix elements and process libraries
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{BLHA Interface}
	\includemodulegraph{blha}

	The code in this chapter implements support for the BLHA record that
	communicates data for NLO processes.

	These are the modules:
	\begin{description}
	\item[blha\_config]
	\item[blha\_olp\_interfaces]
	\end{description}

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	The module is split into a configuration interface which manages configuration
	and handles the request and contract files, a module which interfaces the OLP
	matrix elements and a driver.

	<<[[blha_config.f90]]>>=
	<<File header>>

	module blha_config

	use kinds
	<<Use strings>>
	use variables, only: var_list_t
	use model_data
	use beam_structures, only: beam_structure_t

	<<Standard module head>>

	<<BLHA config: public>>

	<<BLHA config: parameters>>

	<<BLHA config: types>>

	<<BLHA config: variables>>

	<<BLHA config: interfaces>>

	interface
	<<BLHA config: sub interfaces>>
	end interface

	end module blha_config

	@ %def blha_config
	@
	<<[[blha_config_sub.f90]]>>=
	<<File header>>

	submodule (blha_config) blha_config_s

	<<Use mpi f08>>
	use io_units
	use constants
	use string_utils
	use physics_defs, only: PHOTON, PHOTON_OFFSHELL
	use diagnostics
	use flavors
	use pdg_arrays

	implicit none

	contains

	<<BLHA config: procedures>>

	end submodule blha_config_s

	@ %def blha_config_s
	@
	\section{Configuration}

	Parameters to enumerate the different options in the order.
	<<BLHA config: parameters>>=
	integer, public, parameter :: &
	BLHA_CT_QCD = 1, BLHA_CT_EW = 2, BLHA_CT_OTHER = 3
	integer, public, parameter :: &
	BLHA_IRREG_CDR = 1, BLHA_IRREG_DRED = 2, BLHA_IRREG_THV = 3, &
	BLHA_IRREG_MREG = 4, BLHA_IRREG_OTHER = 5
	integer, public, parameter :: &
	BLHA_MPS_ONSHELL = 1, BLHA_MPS_OTHER = 2
	integer, public, parameter :: &
	BLHA_MODE_GOSAM = 1, BLHA_MODE_FEYNARTS = 2, BLHA_MODE_GENERIC = 3, &
	BLHA_MODE_OPENLOOPS = 4
	integer, public, parameter :: &
	BLHA_VERSION_1 = 1, BLHA_VERSION_2 = 2
	integer, public, parameter :: &
	BLHA_AMP_LOOP = 1, BLHA_AMP_COLOR_C = 2, BLHA_AMP_SPIN_C = 3, &
	BLHA_AMP_TREE = 4, BLHA_AMP_LOOPINDUCED = 5
	integer, public, parameter :: &
	BLHA_EW_INTERNAL = 0, &
	BLHA_EW_GF = 1, BLHA_EW_MZ = 2, BLHA_EW_MSBAR = 3, &
	BLHA_EW_0 = 4, BLHA_EW_RUN = 5
	integer, public, parameter :: &
	BLHA_WIDTH_COMPLEX = 1, BLHA_WIDTH_FIXED = 2, &
	BLHA_WIDTH_RUNNING = 3, BLHA_WIDTH_POLE = 4, &
	BLHA_WIDTH_DEFAULT = 5

	@ %def blha_ct_qcd blha_ct_ew blha_ct_other
	@ %def blha_irreg_cdr blha_irreg_dred blha_irreg_thv blha_irreg_mreg blha_irreg_other
	@ %def blha_mps_onshell blha_mps_other
	@ %def blha_mode_gosam blha_mode_feynarts blha_mode_generic
	@ %def blha version blha_amp blha_ew blha_width
	@
	Those are the default pdg codes for massive particles in BLHA programs
	<<BLHA config: parameters>>=
	integer, parameter, public :: OLP_N_MASSIVE_PARTICLES = 12
	integer, dimension(OLP_N_MASSIVE_PARTICLES), public :: &
	OLP_MASSIVE_PARTICLES = [5, -5, 6, -6, 13, -13, 15, -15, 23, 24, -24, 25]
	integer, parameter :: OLP_HEL_UNPOLARIZED = 0

	@ %def OLP_MASSIVE_PARTICLES
	@ The user might provide an extra command string for OpenLoops to
	apply special libraries instead of the default ones, such as
	signal-only amplitudes for off-shell top production. We check in this
	subroutine that the provided string is valid and print out the
	possible options to ease the user's memory.
	<<BLHA config: parameters>>=
	integer, parameter :: N_KNOWN_SPECIAL_OL_METHODS = 3
	<<BLHA config: procedures>>=
	subroutine check_extra_cmd (extra_cmd)
	type(string_t), intent(in) :: extra_cmd
	type(string_t), dimension(N_KNOWN_SPECIAL_OL_METHODS) :: known_methods
	integer :: i
	logical :: found
	known_methods(1) = 'top'
	known_methods(2) = 'not'
	known_methods(3) = 'stop'
	if (extra_cmd == var_str ("")) return
	found = .false.
	do i = 1, N_KNOWN_SPECIAL_OL_METHODS
	found = found .or. &
	(extra_cmd == var_str ('extra approx ') // known_methods(i))
	end do
	if (.not. found) &
	call msg_fatal ("The given extra OpenLoops method is not kown ", &
	[var_str ("Available commands are: "), &
	var_str ("extra approx top (only WbWb signal),"), &
	var_str ("extra approx stop (only WbWb singletop),"), &
	var_str ("extra approx not (no top in WbWb).")])
	end subroutine check_extra_cmd

	@ %def check_extra_cmd
	@ This type contains the pdg code of the particle to be written in the process
	specification string and an optional additional information about the polarization
	of the particles. Note that the output can only be processed by OpenLoops.
	<<BLHA config: types>>=
	type :: blha_particle_string_element_t
	integer :: pdg = 0
	integer :: hel = OLP_HEL_UNPOLARIZED
	logical :: polarized = .false.
	contains
	<<BLHA config: blha particle string element: TBP>>
	end type blha_particle_string_element_t

	@ %def blha_particle_string_element_t
	@
	<<BLHA config: blha particle string element: TBP>>=
	generic :: init => init_default
	generic :: init => init_polarized
	procedure :: init_default => blha_particle_string_element_init_default
	procedure :: init_polarized => blha_particle_string_element_init_polarized
	<<BLHA config: sub interfaces>>=
	module subroutine blha_particle_string_element_init_default (blha_p, id)
	class(blha_particle_string_element_t), intent(out) :: blha_p
	integer, intent(in) :: id
	end subroutine blha_particle_string_element_init_default
	module subroutine blha_particle_string_element_init_polarized (blha_p, id, hel)
	class(blha_particle_string_element_t), intent(out) :: blha_p
	integer, intent(in) :: id, hel
	end subroutine blha_particle_string_element_init_polarized
	<<BLHA config: procedures>>=
	module subroutine blha_particle_string_element_init_default (blha_p, id)
	class(blha_particle_string_element_t), intent(out) :: blha_p
	integer, intent(in) :: id
	blha_p%pdg = id
	end subroutine blha_particle_string_element_init_default

	@ %def blha_particle_string_element_init_default
	@
	<<BLHA config: procedures>>=
	module subroutine blha_particle_string_element_init_polarized (blha_p, id, hel)
	class(blha_particle_string_element_t), intent(out) :: blha_p
	integer, intent(in) :: id, hel
	blha_p%polarized = .true.
	blha_p%pdg = id
	blha_p%hel = hel
	end subroutine blha_particle_string_element_init_polarized

	@ %def blha_particle_string_element_init_polarized
	@
	<<BLHA config: blha particle string element: TBP>>=
	generic :: write_pdg => write_pdg_unit
	generic :: write_pdg => write_pdg_character
	procedure :: write_pdg_unit => blha_particle_string_element_write_pdg_unit
	procedure :: write_pdg_character &
	=> blha_particle_string_element_write_pdg_character
	<<BLHA config: sub interfaces>>=
	module subroutine blha_particle_string_element_write_pdg_unit (blha_p, unit)
	class(blha_particle_string_element_t), intent(in) :: blha_p
	integer, intent(in), optional :: unit
	end subroutine blha_particle_string_element_write_pdg_unit
	module subroutine blha_particle_string_element_write_pdg_character (blha_p, c)
	class(blha_particle_string_element_t), intent(in) :: blha_p
	character(3), intent(inout) :: c
	end subroutine blha_particle_string_element_write_pdg_character
	<<BLHA config: procedures>>=
	module subroutine blha_particle_string_element_write_pdg_unit (blha_p, unit)
	class(blha_particle_string_element_t), intent(in) :: blha_p
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, '(I3)') blha_p%pdg
	end subroutine blha_particle_string_element_write_pdg_unit

	@ %def blha_particle_string_element_write_pdg_unit
	@
	<<BLHA config: procedures>>=
	module subroutine blha_particle_string_element_write_pdg_character (blha_p, c)
	class(blha_particle_string_element_t), intent(in) :: blha_p
	character(3), intent(inout) :: c
	write (c, '(I3)') blha_p%pdg
	end subroutine blha_particle_string_element_write_pdg_character

	@ %def blha_particle_string_element_write_pdg_character
	@
	<<BLHA config: blha particle string element: TBP>>=
	generic :: write_helicity => write_helicity_unit
	generic :: write_helicity => write_helicity_character
	procedure :: write_helicity_unit &
	=> blha_particle_string_element_write_helicity_unit
	procedure :: write_helicity_character &
	=> blha_particle_string_element_write_helicity_character
	<<BLHA config: sub interfaces>>=
	module subroutine blha_particle_string_element_write_helicity_unit (blha_p, unit)
	class(blha_particle_string_element_t), intent(in) :: blha_p
	integer, intent(in), optional :: unit
	end subroutine blha_particle_string_element_write_helicity_unit
	module subroutine blha_particle_string_element_write_helicity_character (blha_p, c)
	class(blha_particle_string_element_t), intent(in) :: blha_p
	character(4), intent(inout) :: c
	end subroutine blha_particle_string_element_write_helicity_character
	<<BLHA config: procedures>>=
	module subroutine blha_particle_string_element_write_helicity_unit (blha_p, unit)
	class(blha_particle_string_element_t), intent(in) :: blha_p
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, '(A1,I0,A1)') '(', blha_p%hel, ')'
	end subroutine blha_particle_string_element_write_helicity_unit

	@ %def blha_particle_string_element_write_helicity_unit
	@
	<<BLHA config: procedures>>=
	module subroutine blha_particle_string_element_write_helicity_character (blha_p, c)
	class(blha_particle_string_element_t), intent(in) :: blha_p
	character(4), intent(inout) :: c
	write (c, '(A1,I0,A1)') '(', blha_p%hel, ')'
	end subroutine blha_particle_string_element_write_helicity_character

	@ %def blha_particle_string_element_write_helicity_character
	@ This type encapsulates a BLHA request.
	<<BLHA config: public>>=
	public :: blha_configuration_t
	public :: blha_cfg_process_node_t
	<<BLHA config: types>>=
	type :: blha_cfg_process_node_t
	type(blha_particle_string_element_t), dimension(:), allocatable :: pdg_in, pdg_out
	integer, dimension(:), allocatable :: fingerprint
	integer :: nsub
	integer, dimension(:), allocatable :: ids
	integer :: amplitude_type
	type(blha_cfg_process_node_t), pointer :: next => null ()
	end type blha_cfg_process_node_t

	type :: blha_configuration_t
	type(string_t) :: name
	class(model_data_t), pointer :: model => null ()
	type(string_t) :: md5
	integer :: version = 2
	logical :: dirty = .false.
	integer :: n_proc = 0
	real(default) :: accuracy_target
	logical :: debug_unstable = .false.
	integer :: mode = BLHA_MODE_GENERIC
	logical :: polarized = .false.
	type(blha_cfg_process_node_t), pointer :: processes => null ()
	!integer, dimension(2) :: matrix_element_square_type = BLHA_MEST_SUM
	integer :: correction_type
	type(string_t) :: correction_type_other
	integer :: irreg = BLHA_IRREG_THV
	type(string_t) :: irreg_other
	integer :: massive_particle_scheme = BLHA_MPS_ONSHELL
	type(string_t) :: massive_particle_scheme_other
	type(string_t) :: model_file
	logical :: subdivide_subprocesses = .false.
	integer :: alphas_power = -1, alpha_power = -1
	integer :: ew_scheme = BLHA_EW_GF
	integer :: width_scheme = BLHA_WIDTH_DEFAULT
	logical :: openloops_use_cms = .false.
	integer :: openloops_phs_tolerance = 0
	type(string_t) :: openloops_extra_cmd
	type(string_t) :: openloops_allowed_libs
	integer :: openloops_stability_log = 0
	integer :: n_off_photons_is = 0
	integer :: n_off_photons_fs = 0
	end type blha_configuration_t

	@ %def blha_cffg_process_node_t blha_configuration_t
	@ Translate the SINDARIN input string to the corresponding named integer.
	<<BLHA config: public>>=
	public :: ew_scheme_string_to_int
	<<BLHA config: sub interfaces>>=
	module function ew_scheme_string_to_int (ew_scheme_str) result (ew_scheme_int)
	integer :: ew_scheme_int
	type(string_t), intent(in) :: ew_scheme_str
	end function ew_scheme_string_to_int
	<<BLHA config: procedures>>=
	module function ew_scheme_string_to_int (ew_scheme_str) result (ew_scheme_int)
	integer :: ew_scheme_int
	type(string_t), intent(in) :: ew_scheme_str
	select case (char (ew_scheme_str))
	case ('GF', 'Gmu')
	ew_scheme_int = BLHA_EW_GF
	case ('alpha_qed', 'alpha_internal')
	ew_scheme_int = BLHA_EW_INTERNAL
	case ('alpha_mz')
	ew_scheme_int = BLHA_EW_MZ
	case ('alpha_0', 'alpha_thompson')
	ew_scheme_int = BLHA_EW_0
	case default
	call msg_fatal ("ew_scheme: " // char (ew_scheme_str) // &
	" not supported. Try 'Gmu', 'alpha_internal', 'alpha_mz' or 'alpha_0'.")
	end select
	end function ew_scheme_string_to_int

	@ %def ew_scheme_string_to_int
	@
	@ Translate the SINDARIN input string to the corresponding named integer
	denoting the type of NLO correction.
	<<BLHA config: public>>=
	public :: correction_type_string_to_int
	<<BLHA config: sub interfaces>>=
	module function correction_type_string_to_int &
	(correction_type_str) result (correction_type_int)
	integer :: correction_type_int
	type(string_t), intent(in) :: correction_type_str
	end function correction_type_string_to_int
	<<BLHA config: procedures>>=
	module function correction_type_string_to_int &
	(correction_type_str) result (correction_type_int)
	integer :: correction_type_int
	type(string_t), intent(in) :: correction_type_str
	select case (char (correction_type_str))
	case ('QCD')
	correction_type_int = BLHA_CT_QCD
	case ('EW')
	correction_type_int = BLHA_CT_EW
	case default
	call msg_warning ("nlo_correction_type: " // char (correction_type_str) // &
	" not supported. Try setting it to 'QCD', 'EW'.")
	end select
	end function correction_type_string_to_int

	@ %def correction_type_string_to_int
	@
	This types control the creation of BLHA-interface files
	<<BLHA config: public>>=
	public :: blha_flv_state_t
	public :: blha_master_t
	<<BLHA config: types>>=
	type:: blha_flv_state_t
	integer, dimension(:), allocatable :: flavors
	integer :: flv_mult
	logical :: flv_real = .false.
	end type blha_flv_state_t

	type :: blha_master_t
	integer, dimension(5) :: blha_mode = BLHA_MODE_GENERIC
	logical :: compute_borns = .false.
	logical :: compute_real_trees = .false.
	logical :: compute_loops = .true.
	logical :: compute_correlations = .false.
	logical :: compute_dglap = .false.
	integer :: ew_scheme
	type(string_t), dimension(:), allocatable :: suffix
	type(blha_configuration_t), dimension(:), allocatable :: blha_cfg
	integer :: n_files = 0
	integer, dimension(:), allocatable :: i_file_to_nlo_index
	contains
	<<BLHA config: blha master: TBP>>
	end type blha_master_t

	@ %def blha_flv_state_t, blha_master_t
	@ Master-Routines
	<<BLHA config: blha master: TBP>>=
	procedure :: set_methods => blha_master_set_methods
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_set_methods (master, is_nlo, var_list)
	class(blha_master_t), intent(inout) :: master
	logical, intent(in) :: is_nlo
	type(var_list_t), intent(in) :: var_list
	end subroutine blha_master_set_methods
	<<BLHA config: procedures>>=
	module subroutine blha_master_set_methods (master, is_nlo, var_list)
	class(blha_master_t), intent(inout) :: master
	logical, intent(in) :: is_nlo
	type(var_list_t), intent(in) :: var_list
	type(string_t) :: method, born_me_method, real_tree_me_method
	type(string_t) :: loop_me_method, correlation_me_method
	type(string_t) :: dglap_me_method
	type(string_t) :: default_method
	logical :: cmp_born, cmp_real
	logical :: cmp_loop, cmp_corr
	logical :: cmp_dglap
	if (is_nlo) then
	method = var_list%get_sval (var_str ("$method"))
	born_me_method = var_list%get_sval (var_str ("$born_me_method"))
	if (born_me_method == "") born_me_method = method
	real_tree_me_method = var_list%get_sval (var_str ("$real_tree_me_method"))
	if (real_tree_me_method == "") real_tree_me_method = method
	loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
	if (loop_me_method == "") loop_me_method = method
	correlation_me_method = var_list%get_sval (var_str ("$correlation_me_method"))
	if (correlation_me_method == "") correlation_me_method = method
	dglap_me_method = var_list%get_sval (var_str ("$dglap_me_method"))
	if (dglap_me_method == "") dglap_me_method = method
	cmp_born = born_me_method /= 'omega'
	cmp_real = is_nlo .and. (real_tree_me_method /= 'omega')
	cmp_loop = is_nlo .and. (loop_me_method /= 'omega')
	cmp_corr = is_nlo .and. (correlation_me_method /= 'omega')
	cmp_dglap = is_nlo .and. (dglap_me_method /= 'omega')
	call set_me_method (1, loop_me_method)
	call set_me_method (2, correlation_me_method)
	call set_me_method (3, real_tree_me_method)
	call set_me_method (4, born_me_method)
	call set_me_method (5, dglap_me_method)
	else
	default_method = var_list%get_sval (var_str ("$method"))
	cmp_born = default_method /= 'omega'
	cmp_real = .false.; cmp_loop = .false.
	cmp_corr = .false.; cmp_dglap = .false.
	call set_me_method (4, default_method)
	end if
	master%n_files = count ([cmp_born, cmp_real, cmp_loop, cmp_corr, cmp_dglap])
	call set_nlo_indices ()
	master%compute_borns = cmp_born
	master%compute_real_trees = cmp_real
	master%compute_loops = cmp_loop
	master%compute_correlations = cmp_corr
	master%compute_dglap = cmp_dglap
	contains
	subroutine set_nlo_indices ()
	integer :: i_file
	allocate (master%i_file_to_nlo_index (master%n_files))
	master%i_file_to_nlo_index = 0
	i_file = 0
	if (cmp_loop) then
	i_file = i_file + 1
	master%i_file_to_nlo_index(i_file) = 1
	end if
	if (cmp_corr) then
	i_file = i_file + 1
	master%i_file_to_nlo_index(i_file) = 2
	end if
	if (cmp_real) then
	i_file = i_file + 1
	master%i_file_to_nlo_index(i_file) = 3
	end if
	if (cmp_born) then
	i_file = i_file + 1
	master%i_file_to_nlo_index(i_file) = 4
	end if
	if (cmp_dglap) then
	i_file = i_file + 1
	master%i_file_to_nlo_index(i_file) = 5
	end if
	end subroutine set_nlo_indices

	subroutine set_me_method (i, me_method)
	integer, intent(in) :: i
	type(string_t) :: me_method
	select case (char (me_method))
	case ('gosam')
	call master%set_gosam (i)
	case ('openloops')
	call master%set_openloops (i)
	end select
	end subroutine set_me_method
	end subroutine blha_master_set_methods

	@ %def blha_master_set_methods
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: allocate_config_files => blha_master_allocate_config_files
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_allocate_config_files (master)
	class(blha_master_t), intent(inout) :: master
	end subroutine blha_master_allocate_config_files
	<<BLHA config: procedures>>=
	module subroutine blha_master_allocate_config_files (master)
	class(blha_master_t), intent(inout) :: master
	allocate (master%blha_cfg (master%n_files))
	allocate (master%suffix (master%n_files))
	end subroutine blha_master_allocate_config_files

	@ %def blha_master_allocate_config_files
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: set_ew_scheme => blha_master_set_ew_scheme
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_set_ew_scheme (master, ew_scheme)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: ew_scheme
	end subroutine blha_master_set_ew_scheme
	<<BLHA config: procedures>>=
	module subroutine blha_master_set_ew_scheme (master, ew_scheme)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: ew_scheme
	master%ew_scheme = ew_scheme_string_to_int (ew_scheme)
	end subroutine blha_master_set_ew_scheme

	@ %def blha_master_set_ew_scheme
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: set_correction_type => blha_master_set_correction_type
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_set_correction_type (master, correction_type_str)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: correction_type_str
	end subroutine blha_master_set_correction_type
	<<BLHA config: procedures>>=
	module subroutine blha_master_set_correction_type (master, correction_type_str)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: correction_type_str
	master%blha_cfg(:)%correction_type = &
	correction_type_string_to_int (correction_type_str)
	end subroutine blha_master_set_correction_type

	@ %def blha_master_set_correction_type
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: set_photon_characteristics => blha_master_set_photon_characteristics
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_set_photon_characteristics (master, flv_born, n_in)
	class(blha_master_t), intent(inout) :: master
	integer, dimension(:,:), intent(in) :: flv_born
	integer, intent(in) :: n_in
	end subroutine blha_master_set_photon_characteristics
	<<BLHA config: procedures>>=
	module subroutine blha_master_set_photon_characteristics (master, flv_born, n_in)
	class(blha_master_t), intent(inout) :: master
	integer, dimension(:,:), intent(in) :: flv_born
	integer, intent(in) :: n_in
	integer :: i_file, i, i_flv
	integer :: noff_is, noff_fs, noff_is_max, noff_fs_max
	do i_file = 1, master%n_files
	noff_is_max = 0; noff_fs_max = 0
	do i_flv = 1, size (flv_born, 2)
	noff_is = 0; noff_fs = 0
	do i = 1, n_in
	if (flv_born (i, i_flv) == PHOTON) noff_is = noff_is + 1
	end do
	noff_is_max = max (noff_is, noff_is_max)
	do i = n_in + 1, size (flv_born(:, i_flv))
	if (flv_born (i, i_flv) == PHOTON) noff_fs = noff_fs + 1
	end do
	noff_fs_max = max (noff_fs, noff_fs_max)
	end do
	if (master%blha_cfg(i_file)%correction_type == BLHA_CT_EW &
	.and. master%ew_scheme == BLHA_EW_0 &
	.and. (noff_is_max > 0 .or. noff_fs_max > 0)) then
	call msg_fatal ("For NLO EW/mixed corrections, 'alpha_0'/" &
	// "'alpha_thompson' are ", [ var_str ("inconsistent EW input " &
	// "schemes. Please use 'alpha_mz' or 'Gmu'")])
	end if
	master%blha_cfg(i_file)%n_off_photons_is = noff_is_max
	master%blha_cfg(i_file)%n_off_photons_fs = noff_fs_max
	end do
	end subroutine blha_master_set_photon_characteristics

	@ %def blha_master_set_photon_characteristics
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: generate => blha_master_generate
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_generate (master, basename, model, &
	n_in, alpha_power, alphas_power, flv_born, flv_real)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, intent(in), dimension(:,:), allocatable :: flv_born, flv_real
	end subroutine blha_master_generate
	<<BLHA config: procedures>>=
	module subroutine blha_master_generate (master, basename, model, &
	n_in, alpha_power, alphas_power, flv_born, flv_real)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, intent(in), dimension(:,:), allocatable :: flv_born, flv_real
	integer :: i_file
	if (master%n_files < 1) &
	call msg_fatal ("Attempting to generate OLP-files, but none are specified!")
	i_file = 1
	call master%generate_loop (basename, model, n_in, alpha_power, &
	alphas_power, flv_born, i_file)
	call master%generate_correlation (basename, model, n_in, alpha_power, &
	alphas_power, flv_born, i_file)
	call master%generate_real_tree (basename, model, n_in, alpha_power, &
	alphas_power, flv_real, i_file)
	call master%generate_born (basename, model, n_in, alpha_power, &
	alphas_power, flv_born, i_file)
	call master%generate_dglap (basename, model, n_in, alpha_power, &
	alphas_power, flv_born, i_file)
	end subroutine blha_master_generate

	@ %def blha_master_generate
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: generate_loop => blha_master_generate_loop
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_generate_loop (master, basename, model, n_in, &
	alpha_power, alphas_power, flv_born, i_file)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable, intent(in) :: flv_born
	integer, intent(inout) :: i_file
	end subroutine blha_master_generate_loop
	<<BLHA config: procedures>>=
	module subroutine blha_master_generate_loop (master, basename, model, n_in, &
	alpha_power, alphas_power, flv_born, i_file)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable, intent(in) :: flv_born
	integer, intent(inout) :: i_file
	type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	integer :: i_flv
	if (master%compute_loops) then
	if (allocated (flv_born)) then
	allocate (blha_flavor (size (flv_born, 2)))
	do i_flv = 1, size (flv_born, 2)
	allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	blha_flavor(i_flv)%flv_mult = 2
	end do
	master%suffix(i_file) = blha_get_additional_suffix (var_str ("_LOOP"))
	call blha_init_virtual (master%blha_cfg(i_file), blha_flavor, &
	n_in, alpha_power, alphas_power, master%ew_scheme, &
	basename, model, master%blha_mode(1), master%suffix(i_file))
	i_file = i_file + 1
	else
	call msg_fatal ("BLHA Loops requested but " &
	// "Born flavor not existing")
	end if
	end if
	end subroutine blha_master_generate_loop

	@ %def blha_master_generate_loop
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: generate_correlation => blha_master_generate_correlation
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_generate_correlation (master, basename, model, n_in, &
	alpha_power, alphas_power, flv_born, i_file)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable, intent(in) :: flv_born
	integer, intent(inout) :: i_file
	end subroutine blha_master_generate_correlation
	<<BLHA config: procedures>>=
	module subroutine blha_master_generate_correlation (master, basename, model, n_in, &
	alpha_power, alphas_power, flv_born, i_file)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable, intent(in) :: flv_born
	integer, intent(inout) :: i_file
	type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	integer :: i_flv
	if (master%compute_correlations) then
	if (allocated (flv_born)) then
	allocate (blha_flavor (size (flv_born, 2)))
	do i_flv = 1, size (flv_born, 2)
	allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	blha_flavor(i_flv)%flv_mult = 3
	end do
	master%suffix(i_file) = blha_get_additional_suffix (var_str ("_SUB"))
	call blha_init_subtraction (master%blha_cfg(i_file), blha_flavor, &
	n_in, alpha_power, alphas_power, master%ew_scheme, &
	basename, model, master%blha_mode(2), master%suffix(i_file))
	i_file = i_file + 1
	else
	call msg_fatal ("BLHA Correlations requested but "&
	// "Born flavor not existing")
	end if
	end if
	end subroutine blha_master_generate_correlation

	@ %def blha_master_generate_correlation
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: generate_real_tree => blha_master_generate_real_tree
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_generate_real_tree (master, basename, model, n_in, &
	alpha_power, alphas_power, flv_real, i_file)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable, intent(in) :: flv_real
	integer, intent(inout) :: i_file
	end subroutine blha_master_generate_real_tree
	<<BLHA config: procedures>>=
	module subroutine blha_master_generate_real_tree (master, basename, model, n_in, &
	alpha_power, alphas_power, flv_real, i_file)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable, intent(in) :: flv_real
	integer, intent(inout) :: i_file
	type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	integer :: i_flv
	if (master%compute_real_trees) then
	if (allocated (flv_real)) then
	allocate (blha_flavor (size (flv_real, 2)))
	do i_flv = 1, size (flv_real, 2)
	allocate (blha_flavor(i_flv)%flavors (size (flv_real(:,i_flv))))
	blha_flavor(i_flv)%flavors = flv_real(:,i_flv)
	blha_flavor(i_flv)%flv_mult = 1
	end do
	master%suffix(i_file) = blha_get_additional_suffix (var_str ("_REAL"))
	call blha_init_real (master%blha_cfg(i_file), blha_flavor, &
	n_in, alpha_power, alphas_power, master%ew_scheme, &
	basename, model, master%blha_mode(3), master%suffix(i_file))
	i_file = i_file + 1
	else
	call msg_fatal ("BLHA Trees requested but "&
	// "Real flavor not existing")
	end if
	end if
	end subroutine blha_master_generate_real_tree

	@ %def blha_master_generate_real_tree
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: generate_born => blha_master_generate_born
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_generate_born (master, basename, model, n_in, &
	alpha_power, alphas_power, flv_born, i_file)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable, intent(in) :: flv_born
	integer, intent(inout) :: i_file
	end subroutine blha_master_generate_born
	<<BLHA config: procedures>>=
	module subroutine blha_master_generate_born (master, basename, model, n_in, &
	alpha_power, alphas_power, flv_born, i_file)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable, intent(in) :: flv_born
	integer, intent(inout) :: i_file
	type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	integer :: i_flv
	if (master%compute_borns) then
	if (allocated (flv_born)) then
	allocate (blha_flavor (size (flv_born, 2)))
	do i_flv = 1, size (flv_born, 2)
	allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	blha_flavor(i_flv)%flv_mult = 1
	end do
	master%suffix(i_file) = blha_get_additional_suffix (var_str ("_BORN"))
	call blha_init_born (master%blha_cfg(i_file), blha_flavor, &
	n_in, alpha_power, alphas_power, master%ew_scheme, &
	basename, model, master%blha_mode(4), master%suffix(i_file))
	i_file = i_file + 1
	end if
	end if
	end subroutine blha_master_generate_born

	@ %def blha_master_generate_born
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: generate_dglap => blha_master_generate_dglap
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_generate_dglap (master, basename, model, n_in, &
	alpha_power, alphas_power, flv_born, i_file)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable, intent(in) :: flv_born
	integer, intent(inout) :: i_file
	end subroutine blha_master_generate_dglap
	<<BLHA config: procedures>>=
	module subroutine blha_master_generate_dglap (master, basename, model, n_in, &
	alpha_power, alphas_power, flv_born, i_file)
	class(blha_master_t), intent(inout) :: master
	type(string_t), intent(in) :: basename
	class(model_data_t), intent(in), target :: model
	integer, intent(in) :: n_in
	integer, intent(in) :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable, intent(in) :: flv_born
	integer, intent(inout) :: i_file
	type(blha_flv_state_t), dimension(:), allocatable :: blha_flavor
	integer :: i_flv
	if (master%compute_dglap) then
	if (allocated (flv_born)) then
	allocate (blha_flavor (size (flv_born, 2)))
	do i_flv = 1, size (flv_born, 2)
	allocate (blha_flavor(i_flv)%flavors (size (flv_born(:,i_flv))))
	blha_flavor(i_flv)%flavors = flv_born(:,i_flv)
	blha_flavor(i_flv)%flv_mult = 2
	end do
	master%suffix(i_file) = blha_get_additional_suffix (var_str ("_DGLAP"))
	call blha_init_dglap (master%blha_cfg(i_file), blha_flavor, &
	n_in, alpha_power, alphas_power, master%ew_scheme, &
	basename, model, master%blha_mode(5), master%suffix(i_file))
	i_file = i_file + 1
	end if
	end if
	end subroutine blha_master_generate_dglap

	@ %def blha_master_generate_dglap
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: setup_additional_features => blha_master_setup_additional_features
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_setup_additional_features (master, &
	phs_tolerance, use_cms, stability_log, extra_cmd, &
	allowed_libs, beam_structure)
	class(blha_master_t), intent(inout) :: master
	integer, intent(in) :: phs_tolerance
	logical, intent(in) :: use_cms
	type(string_t), intent(in), optional :: extra_cmd, allowed_libs
	integer, intent(in) :: stability_log
	type(beam_structure_t), intent(in), optional :: beam_structure
	end subroutine blha_master_setup_additional_features
	<<BLHA config: procedures>>=
	module subroutine blha_master_setup_additional_features (master, &
	phs_tolerance, use_cms, stability_log, extra_cmd, &
	allowed_libs, beam_structure)
	class(blha_master_t), intent(inout) :: master
	integer, intent(in) :: phs_tolerance
	logical, intent(in) :: use_cms
	type(string_t), intent(in), optional :: extra_cmd, allowed_libs
	integer, intent(in) :: stability_log
	type(beam_structure_t), intent(in), optional :: beam_structure
	integer :: i_file
	logical :: polarized, throw_warning

	polarized = .false.
	if (present (beam_structure)) polarized = beam_structure%has_polarized_beams ()

	throw_warning = .false.
	if (use_cms) then
	throw_warning = throw_warning .or. (master%compute_loops &
	.and. master%blha_mode(1) /= BLHA_MODE_OPENLOOPS)
	throw_warning = throw_warning .or. (master%compute_correlations &
	.and. master%blha_mode(2) /= BLHA_MODE_OPENLOOPS)
	throw_warning = throw_warning .or. (master%compute_real_trees &
	.and. master%blha_mode(3) /= BLHA_MODE_OPENLOOPS)
	throw_warning = throw_warning .or. (master%compute_borns &
	.and. master%blha_mode(4) /= BLHA_MODE_OPENLOOPS)
	throw_warning = throw_warning .or. (master%compute_dglap &
	.and. master%blha_mode(5) /= BLHA_MODE_OPENLOOPS)
	if (throw_warning) call cms_warning ()
	end if

	do i_file = 1, master%n_files
	if (phs_tolerance > 0) then
	select case (master%blha_mode (master%i_file_to_nlo_index(i_file)))
	case (BLHA_MODE_GOSAM)
	if (polarized) call gosam_error_message ()
	case (BLHA_MODE_OPENLOOPS)
	master%blha_cfg(i_file)%openloops_use_cms = use_cms
	master%blha_cfg(i_file)%openloops_phs_tolerance = phs_tolerance
	master%blha_cfg(i_file)%polarized = polarized
	if (present (extra_cmd)) then
	master%blha_cfg(i_file)%openloops_extra_cmd = extra_cmd
	else
	master%blha_cfg(i_file)%openloops_extra_cmd = var_str ('')
	end if
	if (present (allowed_libs)) then
	master%blha_cfg(i_file)%openloops_allowed_libs = allowed_libs
	else
	master%blha_cfg(i_file)%openloops_allowed_libs = var_str ('')
	end if
	master%blha_cfg(i_file)%openloops_stability_log = stability_log
	end select
	end if
	end do
	contains
	subroutine cms_warning ()
	call msg_warning ("You have set ?openloops_use_cms = true, but not all active matrix ", &
	[var_str ("element methods are set to OpenLoops. Note that other "), &
	var_str ("methods might not necessarily support the complex mass "), &
	var_str ("scheme. This can yield inconsistencies in your NLO results!")])
	end subroutine cms_warning

	subroutine gosam_error_message ()
	call msg_fatal ("You are trying to evaluate a process at NLO ", &
	[var_str ("which involves polarized beams using GoSam. "), &
	var_str ("This feature is not supported yet. "), &
	var_str ("Please use OpenLoops instead")])
	end subroutine gosam_error_message
	end subroutine blha_master_setup_additional_features

	@ %def blha_master_setup_additional_features
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: set_gosam => blha_master_set_gosam
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_set_gosam (master, i)
	class(blha_master_t), intent(inout) :: master
	integer, intent(in) :: i
	end subroutine blha_master_set_gosam
	<<BLHA config: procedures>>=
	module subroutine blha_master_set_gosam (master, i)
	class(blha_master_t), intent(inout) :: master
	integer, intent(in) :: i
	master%blha_mode(i) = BLHA_MODE_GOSAM
	end subroutine blha_master_set_gosam

	@ %def blha_master_set_gosam
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: set_openloops => blha_master_set_openloops
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_set_openloops (master, i)
	class(blha_master_t), intent(inout) :: master
	integer, intent(in) :: i
	end subroutine blha_master_set_openloops
	<<BLHA config: procedures>>=
	module subroutine blha_master_set_openloops (master, i)
	class(blha_master_t), intent(inout) :: master
	integer, intent(in) :: i
	master%blha_mode(i) = BLHA_MODE_OPENLOOPS
	end subroutine blha_master_set_openloops

	@ %def blha_master_set_openloops
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: set_polarization => blha_master_set_polarization
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_set_polarization (master, i)
	class(blha_master_t), intent(inout) :: master
	integer, intent(in) :: i
	end subroutine blha_master_set_polarization
	<<BLHA config: procedures>>=
	module subroutine blha_master_set_polarization (master, i)
	class(blha_master_t), intent(inout) :: master
	integer, intent(in) :: i
	master%blha_cfg(i)%polarized = .true.
	end subroutine blha_master_set_polarization

	@ %def blha_master_set_polarization
	@
	<<BLHA config: procedures>>=
	subroutine blha_init_born (blha_cfg, blha_flavor, n_in, &
	ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	type(blha_configuration_t), intent(inout) :: blha_cfg
	type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	integer, intent(in) :: n_in
	integer, intent(in) :: ap, asp
	integer, intent(in) :: ew_scheme
	type(string_t), intent(in) :: basename
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: blha_mode
	type(string_t), intent(in) :: suffix
	integer, dimension(:), allocatable :: amp_type
	integer :: i, n_cp_loopind

	allocate (amp_type (size (blha_flavor)))
	n_cp_loopind = 0
	n_cp_loopind = size (blha_flavor(1)%flavors)
	if ((ap + asp) == n_cp_loopind) then
	do i = 1, size (blha_flavor)
	amp_type(i) = BLHA_AMP_LOOPINDUCED
	end do
	else
	do i = 1, size (blha_flavor)
	amp_type(i) = BLHA_AMP_TREE
	end do
	end if
	call blha_configuration_init (blha_cfg, basename // suffix , &
	model, blha_mode)
	call blha_configuration_append_processes (blha_cfg, n_in, &
	blha_flavor, amp_type)
	call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	irreg = BLHA_IRREG_CDR, alphas_power = asp, &
	alpha_power = ap, ew_scheme = ew_scheme, &
	debug = blha_mode == BLHA_MODE_GOSAM)
	end subroutine blha_init_born

	subroutine blha_init_virtual (blha_cfg, blha_flavor, n_in, &
	ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	type(blha_configuration_t), intent(inout) :: blha_cfg
	type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	integer, intent(in) :: n_in
	integer, intent(in) :: ap, asp
	integer, intent(in) :: ew_scheme
	type(string_t), intent(in) :: basename
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: blha_mode
	type(string_t), intent(in) :: suffix
	integer, dimension(:), allocatable :: amp_type
	integer :: i

	allocate (amp_type (size (blha_flavor) * 2))
	do i = 1, size (blha_flavor)
	amp_type(2 * i - 1) = BLHA_AMP_LOOP
	amp_type(2 * i) = BLHA_AMP_COLOR_C
	end do
	call blha_configuration_init (blha_cfg, basename // suffix , &
	model, blha_mode)
	call blha_configuration_append_processes (blha_cfg, n_in, &
	blha_flavor, amp_type)
	call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	irreg = BLHA_IRREG_CDR, &
	alphas_power = asp, &
	alpha_power = ap, &
	ew_scheme = ew_scheme, &
	debug = blha_mode == BLHA_MODE_GOSAM)
	end subroutine blha_init_virtual

	subroutine blha_init_dglap (blha_cfg, blha_flavor, n_in, &
	ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	type(blha_configuration_t), intent(inout) :: blha_cfg
	type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	integer, intent(in) :: n_in
	integer, intent(in) :: ap, asp
	integer, intent(in) :: ew_scheme
	type(string_t), intent(in) :: basename
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: blha_mode
	type(string_t), intent(in) :: suffix
	integer, dimension(:), allocatable :: amp_type
	integer :: i

	allocate (amp_type (size (blha_flavor) * 2))
	do i = 1, size (blha_flavor)
	amp_type(2 * i - 1) = BLHA_AMP_TREE
	amp_type(2 * i) = BLHA_AMP_COLOR_C
	end do
	call blha_configuration_init (blha_cfg, basename // suffix , &
	model, blha_mode)
	call blha_configuration_append_processes (blha_cfg, n_in, &
	blha_flavor, amp_type)
	call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	irreg = BLHA_IRREG_CDR, &
	alphas_power = asp, &
	alpha_power = ap, &
	ew_scheme = ew_scheme, &
	debug = blha_mode == BLHA_MODE_GOSAM)
	end subroutine blha_init_dglap

	subroutine blha_init_subtraction (blha_cfg, blha_flavor, n_in, &
	ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	type(blha_configuration_t), intent(inout) :: blha_cfg
	type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	integer, intent(in) :: n_in
	integer, intent(in) :: ap, asp
	integer, intent(in) :: ew_scheme
	type(string_t), intent(in) :: basename
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: blha_mode
	type(string_t), intent(in) :: suffix
	integer, dimension(:), allocatable :: amp_type
	integer :: i

	allocate (amp_type (size (blha_flavor) * 3))
	do i = 1, size (blha_flavor)
	amp_type(3 * i - 2) = BLHA_AMP_TREE
	amp_type(3 * i - 1) = BLHA_AMP_COLOR_C
	amp_type(3 * i) = BLHA_AMP_SPIN_C
	end do
	call blha_configuration_init (blha_cfg, basename // suffix , &
	model, blha_mode)
	call blha_configuration_append_processes (blha_cfg, n_in, &
	blha_flavor, amp_type)
	call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	irreg = BLHA_IRREG_CDR, &
	alphas_power = asp, &
	alpha_power = ap, &
	ew_scheme = ew_scheme, &
	debug = blha_mode == BLHA_MODE_GOSAM)
	end subroutine blha_init_subtraction

	subroutine blha_init_real (blha_cfg, blha_flavor, n_in, &
	ap, asp, ew_scheme, basename, model, blha_mode, suffix)
	type(blha_configuration_t), intent(inout) :: blha_cfg
	type(blha_flv_state_t), intent(in), dimension(:) :: blha_flavor
	integer, intent(in) :: n_in
	integer, intent(in) :: ap, asp
	integer :: ap_ew, ap_qcd
	integer, intent(in) :: ew_scheme
	type(string_t), intent(in) :: basename
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: blha_mode
	type(string_t), intent(in) :: suffix
	integer, dimension(:), allocatable :: amp_type
	integer :: i

	allocate (amp_type (size (blha_flavor)))
	do i = 1, size (blha_flavor)
	amp_type(i) = BLHA_AMP_TREE
	end do
	select case (blha_cfg%correction_type)
	case (BLHA_CT_QCD)
	ap_ew = ap
	ap_qcd = asp + 1
	case (BLHA_CT_EW)
	ap_ew = ap + 1
	ap_qcd = asp
	end select
	call blha_configuration_init (blha_cfg, basename // suffix , &
	model, blha_mode)
	call blha_configuration_append_processes (blha_cfg, n_in, &
	blha_flavor, amp_type)

	call blha_configuration_set (blha_cfg, BLHA_VERSION_2, &
	irreg = BLHA_IRREG_CDR, &
	alphas_power = ap_qcd, &
	alpha_power = ap_ew, &
	ew_scheme = ew_scheme, &
	debug = blha_mode == BLHA_MODE_GOSAM)
	end subroutine blha_init_real

	@ %def blha_init_virtual blha_init_real
	@ %def blha_init_subtraction
	@
	<<BLHA config: public>>=
	public :: blha_get_additional_suffix
	<<BLHA config: sub interfaces>>=
	module function blha_get_additional_suffix (base_suffix) result (suffix)
	type(string_t) :: suffix
	type(string_t), intent(in) :: base_suffix
	end function blha_get_additional_suffix
	<<BLHA config: procedures>>=
	module function blha_get_additional_suffix (base_suffix) result (suffix)
	type(string_t) :: suffix
	type(string_t), intent(in) :: base_suffix
	<<blha master: blha master extend suffixes: variables>>
	suffix = base_suffix
	<<blha master: blha master extend suffixes: procedure>>
	end function blha_get_additional_suffix

	@ %def blha_master_extend_suffixes
	@
	<<MPI: blha master: blha master extend suffixes: variables>>=
	integer :: n_size, rank
	<<MPI: blha master: blha master extend suffixes: procedure>>=
	call MPI_Comm_rank (MPI_COMM_WORLD, rank)
	call MPI_Comm_size (MPI_COMM_WORLD, n_size)
	if (n_size > 1) then
	suffix = suffix // var_str ("_") // str (rank)
	end if
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: write_olp => blha_master_write_olp
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_write_olp (master, basename)
	class(blha_master_t), intent(in) :: master
	type(string_t), intent(in) :: basename
	end subroutine blha_master_write_olp
	<<BLHA config: procedures>>=
	module subroutine blha_master_write_olp (master, basename)
	class(blha_master_t), intent(in) :: master
	type(string_t), intent(in) :: basename
	integer :: unit
	type(string_t) :: filename
	integer :: i_file
	do i_file = 1, master%n_files
	filename = basename // master%suffix(i_file) // ".olp"
	unit = free_unit ()
	open (unit, file = char (filename), status = 'replace', action = 'write')
	call blha_configuration_write &
	(master%blha_cfg(i_file), master%suffix(i_file), unit)
	close (unit)
	end do
	end subroutine blha_master_write_olp

	@ %def blha_master_write_olp
	@
	<<BLHA config: blha master: TBP>>=
	procedure :: final => blha_master_final
	<<BLHA config: sub interfaces>>=
	module subroutine blha_master_final (master)
	class(blha_master_t), intent(inout) :: master
	end subroutine blha_master_final
	<<BLHA config: procedures>>=
	module subroutine blha_master_final (master)
	class(blha_master_t), intent(inout) :: master
	master%n_files = 0
	deallocate (master%suffix)
	deallocate (master%blha_cfg)
	deallocate (master%i_file_to_nlo_index)
	end subroutine blha_master_final

	@ %def blha_master_final
	@
	<<BLHA config: public>>=
	public :: blha_configuration_init
	<<BLHA config: sub interfaces>>=
	module subroutine blha_configuration_init (cfg, name, model, mode)
	type(blha_configuration_t), intent(inout) :: cfg
	type(string_t), intent(in) :: name
	class(model_data_t), target, intent(in) :: model
	integer, intent(in), optional :: mode
	end subroutine blha_configuration_init
	<<BLHA config: procedures>>=
	module subroutine blha_configuration_init (cfg, name, model, mode)
	type(blha_configuration_t), intent(inout) :: cfg
	type(string_t), intent(in) :: name
	class(model_data_t), target, intent(in) :: model
	integer, intent(in), optional :: mode
	if (.not. associated (cfg%model)) then
	cfg%name = name
	cfg%model => model
	end if
	if (present (mode)) cfg%mode = mode
	end subroutine blha_configuration_init

	@ %def blha_configuration_init
	@ Create an array of massive particle indices, to be used by the
	"MassiveParticle"-statement of the order file.
	<<BLHA config: procedures>>=
	subroutine blha_configuration_get_massive_particles &
	(cfg, massive, i_massive)
	type(blha_configuration_t), intent(in) :: cfg
	logical, intent(out) :: massive
	integer, intent(out), dimension(:), allocatable :: i_massive
	integer, parameter :: max_particles = 10
	integer, dimension(max_particles) :: i_massive_tmp
	integer, dimension(max_particles) :: checked
	type(blha_cfg_process_node_t), pointer :: current_process
	integer :: k
	integer :: n_massive
	n_massive = 0; k = 1
	checked = 0
	if (associated (cfg%processes)) then
	current_process => cfg%processes
	else
	call msg_fatal ("BLHA, massive particles: " // &
	"No processes allocated!")
	end if
	do
	call check_pdg_list (current_process%pdg_in%pdg)
	call check_pdg_list (current_process%pdg_out%pdg)
	if (k > max_particles) &
	call msg_fatal ("BLHA, massive particles: " // &
	"Max. number of particles exceeded!")
	if (associated (current_process%next)) then
	current_process => current_process%next
	else
	exit
	end if
	end do
	if (n_massive > 0) then
	allocate (i_massive (n_massive))
	i_massive = i_massive_tmp (1:n_massive)
	massive = .true.
	else
	massive = .false.
	end if
	contains
	subroutine check_pdg_list (pdg_list)
	integer, dimension(:), intent(in) :: pdg_list
	integer :: i, i_pdg
	type(flavor_t) :: flv
	do i = 1, size (pdg_list)
	i_pdg = abs (pdg_list(i))
	call flv%init (i_pdg, cfg%model)
	if (flv%get_mass () > 0._default) then
	!!! Avoid duplicates in output
	if (.not. any (checked == i_pdg)) then
	i_massive_tmp(k) = i_pdg
	checked(k) = i_pdg
	k = k + 1
	n_massive = n_massive + 1
	end if
	end if
	end do
	end subroutine check_pdg_list
	end subroutine blha_configuration_get_massive_particles

	@ %def blha_configuration_get_massive_particles
	@
	<<BLHA config: public>>=
	public :: blha_configuration_append_processes
	<<BLHA config: sub interfaces>>=
	module subroutine blha_configuration_append_processes (cfg, n_in, flavor, amp_type)
	type(blha_configuration_t), intent(inout) :: cfg
	integer, intent(in) :: n_in
	type(blha_flv_state_t), dimension(:), intent(in) :: flavor
	integer, dimension(:), intent(in), optional :: amp_type
	end subroutine blha_configuration_append_processes
	<<BLHA config: procedures>>=
	module subroutine blha_configuration_append_processes (cfg, n_in, flavor, amp_type)
	type(blha_configuration_t), intent(inout) :: cfg
	integer, intent(in) :: n_in
	type(blha_flv_state_t), dimension(:), intent(in) :: flavor
	integer, dimension(:), intent(in), optional :: amp_type
	integer :: n_tot
	type(blha_cfg_process_node_t), pointer :: current_node
	integer :: i_process, i_flv
	integer, dimension(:), allocatable :: pdg_in, pdg_out
	integer, dimension(:), allocatable :: flavor_state
	integer :: proc_offset, n_proc_tot
	proc_offset = 0; n_proc_tot = 0
	do i_flv = 1, size (flavor)
	n_proc_tot = n_proc_tot + flavor(i_flv)%flv_mult
	end do
	if (.not. associated (cfg%processes)) &
	allocate (cfg%processes)
	current_node => cfg%processes
	do i_flv = 1, size (flavor)
	n_tot = size (flavor(i_flv)%flavors)
	allocate (pdg_in (n_in), pdg_out (n_tot - n_in))
	allocate (flavor_state (n_tot))
	flavor_state = flavor(i_flv)%flavors
	do i_process = 1, flavor(i_flv)%flv_mult
	pdg_in = flavor_state (1 : n_in)
	pdg_out = flavor_state (n_in + 1 : )
	if (cfg%polarized) then
	select case (cfg%mode)
	case (BLHA_MODE_OPENLOOPS)
	call allocate_and_init_pdg_and_helicities (current_node, &
	pdg_in, pdg_out, amp_type (proc_offset + i_process))
	case (BLHA_MODE_GOSAM)
	!!! Nothing special for GoSam yet. This exception is already caught
	!!! in blha_master_setup_additional_features
	end select
	else
	call allocate_and_init_pdg (current_node, pdg_in, pdg_out, &
	amp_type (proc_offset + i_process))
	end if
	if (proc_offset + i_process /= n_proc_tot) then
	allocate (current_node%next)
	current_node => current_node%next
	end if
	if (i_process == flavor(i_flv)%flv_mult) &
	proc_offset = proc_offset + flavor(i_flv)%flv_mult
	end do
	deallocate (pdg_in, pdg_out)
	deallocate (flavor_state)
	end do

	contains

	subroutine allocate_and_init_pdg (node, pdg_in, pdg_out, amp_type)
	type(blha_cfg_process_node_t), intent(inout), pointer :: node
	integer, intent(in), dimension(:), allocatable :: pdg_in, pdg_out
	integer, intent(in) :: amp_type
	allocate (node%pdg_in (size (pdg_in)))
	allocate (node%pdg_out (size (pdg_out)))
	node%pdg_in%pdg = pdg_in
	node%pdg_out%pdg = pdg_out
	node%amplitude_type = amp_type
	end subroutine allocate_and_init_pdg

	subroutine allocate_and_init_pdg_and_helicities (node, pdg_in, pdg_out, amp_type)
	type(blha_cfg_process_node_t), intent(inout), pointer :: node
	integer, intent(in), dimension(:), allocatable :: pdg_in, pdg_out
	integer, intent(in) :: amp_type
	integer :: h1, h2
	if (size (pdg_in) == 2) then
	do h1 = -1, 1, 2
	do h2 = -1, 1, 2
	call allocate_and_init_pdg (current_node, pdg_in, pdg_out, amp_type)
	current_node%pdg_in(1)%polarized = .true.
	current_node%pdg_in(2)%polarized = .true.
	current_node%pdg_in(1)%hel = h1
	current_node%pdg_in(2)%hel = h2
	if (h1 + h2 /= 2) then !!! not end of loop
	allocate (current_node%next)
	current_node => current_node%next
	end if
	end do
	end do
	else
	do h1 = -1, 1, 2
	call allocate_and_init_pdg (current_node, pdg_in, pdg_out, amp_type)
	current_node%pdg_in(1)%polarized = .true.
	current_node%pdg_in(1)%hel = h1
	if (h1 /= 1) then !!! not end of loop
	allocate (current_node%next)
	current_node => current_node%next
	end if
	end do
	end if
	end subroutine allocate_and_init_pdg_and_helicities

	end subroutine blha_configuration_append_processes

	@ %def blha_configuration_append_processes
	@ Change parameter(s).
	<<BLHA config: public>>=
	public :: blha_configuration_set
	<<BLHA config: sub interfaces>>=
	module subroutine blha_configuration_set (cfg, &
	version, irreg, massive_particle_scheme, &
	model_file, alphas_power, alpha_power, ew_scheme, width_scheme, &
	accuracy, debug)
	type(blha_configuration_t), intent(inout) :: cfg
	integer, optional, intent(in) :: version
	integer, optional, intent(in) :: irreg
	integer, optional, intent(in) :: massive_particle_scheme
	type(string_t), optional, intent(in) :: model_file
	integer, optional, intent(in) :: alphas_power, alpha_power
	integer, optional, intent(in) :: ew_scheme
	integer, optional, intent(in) :: width_scheme
	real(default), optional, intent(in) :: accuracy
	logical, optional, intent(in) :: debug
	end subroutine blha_configuration_set
	<<BLHA config: procedures>>=
	module subroutine blha_configuration_set (cfg, &
	version, irreg, massive_particle_scheme, &
	model_file, alphas_power, alpha_power, ew_scheme, width_scheme, &
	accuracy, debug)
	type(blha_configuration_t), intent(inout) :: cfg
	integer, optional, intent(in) :: version
	integer, optional, intent(in) :: irreg
	integer, optional, intent(in) :: massive_particle_scheme
	type(string_t), optional, intent(in) :: model_file
	integer, optional, intent(in) :: alphas_power, alpha_power
	integer, optional, intent(in) :: ew_scheme
	integer, optional, intent(in) :: width_scheme
	real(default), optional, intent(in) :: accuracy
	logical, optional, intent(in) :: debug
	if (present (version)) &
	cfg%version = version
	if (present (irreg)) &
	cfg%irreg = irreg
	if (present (massive_particle_scheme)) &
	cfg%massive_particle_scheme = massive_particle_scheme
	if (present (model_file)) &
	cfg%model_file = model_file
	if (present (alphas_power)) &
	cfg%alphas_power = alphas_power
	if (present (alpha_power)) &
	cfg%alpha_power = alpha_power
	if (present (ew_scheme)) &
	cfg%ew_scheme = ew_scheme
	if (present (width_scheme)) &
	cfg%width_scheme = width_scheme
	if (present (accuracy)) &
	cfg%accuracy_target = accuracy
	if (present (debug)) &
	cfg%debug_unstable = debug
	cfg%dirty = .false.
	end subroutine blha_configuration_set

	@ %def blha_configuration_set
	@
	<<BLHA config: public>>=
	public :: blha_configuration_get_n_proc
	<<BLHA config: sub interfaces>>=
	module function blha_configuration_get_n_proc (cfg) result (n_proc)
	type(blha_configuration_t), intent(in) :: cfg
	integer :: n_proc
	end function blha_configuration_get_n_proc
	<<BLHA config: procedures>>=
	module function blha_configuration_get_n_proc (cfg) result (n_proc)
	type(blha_configuration_t), intent(in) :: cfg
	integer :: n_proc
	n_proc = cfg%n_proc
	end function blha_configuration_get_n_proc

	@ %def blha_configuration_get_n_proc
	@
	Write the BLHA file. Internal mode is intented for md5summing only.

	Special cases of external photons in \texttt{OpenLoops}:

	For electroweak corrections the particle ID (PID) of photons is a crucial input for the
	computation of matrix elements by \texttt{OpenLoops}.
	According to "arXiv: 1907.13071", section 3.2, external photons are classified by the
	following types:
	\begin{itemize}
	\item PID $= -2002$: off-shell photons, that undergo $\gamma\rightarrow f\bar{f}$ splittings
	at NLO EW, or initial state photons from QED PDFs
	\item PID $= 2002$: on-shell photons, that do not undergo $\gamma\rightarrow f\bar{f}$
	splittings at NLO EW, or initial state photons for example at photon colliders
	\item PID $= 22$: unresolved photons, representing radiated photons at NLO EW, absent at LO
	\end{itemize}
	For the first two types scattering amplitudes for processes with external photons at NLO EW
	get renormalisation factors containing photon-coupling and wave function counterterms.
	Logarithmic mass singularities arising due to the renormalisation of off-shell external
	photon wave functions are cancelled by collinear singularities of photon PDF counterterms or
	analogous terms in virtual contributions originating from $\gamma\rightarrow f\bar{f}$
	splittings of final state photons.

	The finite remainders of the renormalisation factors are thus dictated by the specific photon
	PID stated above.
	As consequence, we have to adjust the input PIDs written into the BLHA file which will be
	read by \texttt{OpenLoops}.\\
	Concretely, for the case of electroweak corrections initial state photons associated with
	photon PDFs and final state photons (if existent at LO) are labeled as off-shell photons with
	PID "$-2002$".
	On-shell photons with PID "$2002$" are neglected for now since to include them for processes
	at NLO EW is non-trivial from the phenomenological point of view.
	Processes at NLO EW typically are studied at high energy scales for which photon-induced
	sub-processes in most cases can not be neglected.
	However, on-shell, e.~g. tagged, photons are defined at low energy scales and thus the
	process has to be described with external photon fields and couplings at two different
	scales.

	Another issue which has to be adressed if various photon PIDs are taken into account is that
	real and virtual amplitudes have to be computed at the same order in $\alpha$ at a specific
	scale for the subtraction scheme to be consistent.
	The complication comes by the fact that the EW coupling $\alpha$ of each external photon in
	the amplitudes will automatically be rescaled by \texttt{OpenLoops} corresponding to the
	specific photon type.
	Following eq. (3.30) of "arXiv: 1907.13071", by default the coupling of an on-shell photon
	will be changed to $\alpha(0)$ and that of an off-shell photon to $\alpha_{G_\mu}$ if not
	chosen already at a high scale, e.~g. $\alpha(M_Z)$.
	In order to not spoil the IR cancellation \texttt{OpenLoops} supplies to register unresolved
	photons with PID "22" describing a radiated photon at NLO EW for which the photon-coupling
	$\alpha$ is left unchanged at the value which is computed with the electroweak input scheme
	chosen by the user.
	This is adopted here by labeling each emitted photon as unresolved with PID "22" if no
	photons are present at LO.\\
	For EW corrections the freedom to choose an electroweak input scheme is restricted, however,
	since the number of external photons present at LO is not conserved for the corresponding
	real flavor structures due to possible $\gamma \rightarrow f\bar{f}$ splittings.
	This forbids to choose $\alpha=\alpha(0)$ since otherwise the order in $\alpha(0)$ is not
	conserved in the real amplitudes corresponding to the factorizing Born process.
	Consequently, for FKS the NLO components are not of the same order in $\alpha(0)$.
	The option \texttt{\$blha\_ew\_scheme = "alpha\_0"} is thus refused for the case if EW
	corrections are activated and photons are present at LO.
	<<BLHA config: public>>=
	public :: blha_configuration_write
	<<BLHA config: sub interfaces>>=
	module subroutine blha_configuration_write (cfg, suffix, unit, internal, no_version)
	type(blha_configuration_t), intent(in) :: cfg
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: internal, no_version
	type(string_t), intent(in) :: suffix
	end subroutine blha_configuration_write
	<<BLHA config: procedures>>=
	module subroutine blha_configuration_write (cfg, suffix, unit, internal, no_version)
	type(blha_configuration_t), intent(in) :: cfg
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: internal, no_version
	type(string_t), intent(in) :: suffix
	integer, dimension(:), allocatable :: pdg_flv
	integer :: u
	logical :: full, nlo3
	type(string_t) :: buf
	type(blha_cfg_process_node_t), pointer :: node
	integer :: i
	character(3) :: pdg_char
	character(5) :: pdg_char_extra
	character(4) :: hel_char
	character(6) :: suffix_char
	character(len=25), parameter :: pad = ""
	logical :: write_process, no_v, loop_ind
	+ type(flavor_t) :: flv
	no_v = .false. ; if (present (no_version)) no_v = no_version
	u = given_output_unit (unit); if (u < 0) return
	full = .true.; if (present (internal)) full = .not. internal
	loop_ind = .false.
	if (full .and. cfg%dirty) call msg_bug ( &
	"BUG: attempted to write out a dirty BLHA configuration")
	if (full) then
	if (no_v) then
	write (u, "(A)") "# BLHA order written by WHIZARD [version]"
	else
	write (u, "(A)") "# BLHA order written by WHIZARD <<Version>>"
	end if
	write (u, "(A)")
	end if
	select case (cfg%mode)
	case (BLHA_MODE_GOSAM); buf = "GoSam"
	case (BLHA_MODE_OPENLOOPS); buf = "OpenLoops"
	case default; buf = "vanilla"
	end select
	write (u, "(A)") "# BLHA interface mode: " // char (buf)
	write (u, "(A)") "# process: " // char (cfg%name)
	write (u, "(A)") "# model: " // char (cfg%model%get_name ())
	select case (cfg%version)
	case (1); buf = "BLHA1"
	case (2); buf = "BLHA2"
	end select
	write (u, '(A25,A)') "InterfaceVersion " // pad, char (buf)
	+ if (cfg%model%is_ufo_model ()) then
	+ write (u, "(A25,A)") "Model " // pad, "ufo:/" // &
	+ char(cfg%model%get_ufo_path_name ()) // "/" // &
	+ char (cfg%model%get_name ())
	+ end if
	node => cfg%processes
	do while (associated (node))
	loop_ind = node%amplitude_type == BLHA_AMP_LOOPINDUCED
	node => node%next
	end do
	if (.not. loop_ind) then
	select case (cfg%correction_type)
	case (BLHA_CT_QCD); buf = "QCD"
	case (BLHA_CT_EW); buf = "EW"
	case default; buf = cfg%correction_type_other
	end select
	write (u,'(A25,A)') "CorrectionType" // pad, char (buf)
	end if

	select case (cfg%mode)
	case (BLHA_MODE_OPENLOOPS)
	buf = cfg%name // '.olc'
	write (u, '(A25,A)') "Extra AnswerFile" // pad, char (buf)
	end select

	select case (cfg%irreg)
	case (BLHA_IRREG_CDR); buf = "CDR"
	case (BLHA_IRREG_DRED); buf = "DRED"
	case (BLHA_IRREG_THV); buf = "tHV"
	case (BLHA_IRREG_MREG); buf = "MassReg"
	case default; buf = cfg%irreg_other
	end select
	write (u,'(A25,A)') "IRregularisation" // pad, char (buf)
	select case (cfg%massive_particle_scheme)
	case (BLHA_MPS_ONSHELL); buf = "OnShell"
	case default; buf = cfg%massive_particle_scheme_other
	end select
	if (cfg%mode == BLHA_MODE_GOSAM) &
	write (u,'(A25,A)') "MassiveParticleScheme" // pad, char (buf)
	select case (cfg%version)
	case (1)
	if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	"AlphasPower" // pad, int2char (cfg%alphas_power)
	if (cfg%alpha_power >= 0) write (u,'(A25,A)') &
	"AlphaPower " // pad, int2char (cfg%alpha_power)
	case (2)
	if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	"CouplingPower QCD " // pad, int2char (cfg%alphas_power)
	if (cfg%alpha_power >= 0) write (u, '(A25,A)') &
	"CouplingPower QED " // pad, int2char (cfg%alpha_power)
	end select
	select case (cfg%mode)
	case (BLHA_MODE_GOSAM)
	select case (cfg%ew_scheme)
	case (BLHA_EW_GF, BLHA_EW_INTERNAL); buf = "alphaGF"
	case (BLHA_EW_MZ); buf = "alphaMZ"
	case (BLHA_EW_MSBAR); buf = "alphaMSbar"
	case (BLHA_EW_0); buf = "alpha0"
	case (BLHA_EW_RUN); buf = "alphaRUN"
	end select
	- write (u, '(A25, A)') "EWScheme " // pad, char (buf)
	+ if (.not. cfg%model%is_ufo_model ()) &
	+ write (u, '(A25, A)') "EWScheme " // pad, char (buf)
	case (BLHA_MODE_OPENLOOPS)
	select case (cfg%ew_scheme)
	case (BLHA_EW_0); buf = "alpha0"
	case (BLHA_EW_GF); buf = "Gmu"
	case (BLHA_EW_MZ, BLHA_EW_INTERNAL); buf = "alphaMZ"
	case default
	call msg_fatal ("OpenLoops input: Only supported EW schemes &
	& are 'alpha0', 'Gmu', and 'alphaMZ'")
	end select
	write (u, '(A25, A)') "ewscheme " // pad, char (buf)
	end select
	select case (cfg%mode)
	case (BLHA_MODE_GOSAM)
	write (u, '(A25)', advance='no') "MassiveParticles " // pad
	do i = 1, size (OLP_MASSIVE_PARTICLES)
	- if (OLP_MASSIVE_PARTICLES(i) > 0) &
	- write (u, '(I2,1X)', advance='no') OLP_MASSIVE_PARTICLES(i)
	+ if (OLP_MASSIVE_PARTICLES(i) > 0) then
	+ call flv%init (OLP_MASSIVE_PARTICLES(i), cfg%model)
	+ if (flv%get_mass () > 0._default) then
	+ write (u, '(I2,1X)', advance='no') OLP_MASSIVE_PARTICLES(i)
	+ end if
	+ end if
	end do
	write (u,*)
	case (BLHA_MODE_OPENLOOPS)
	if (cfg%openloops_use_cms) then
	write (u, '(A25,I1)') "extra use_cms " // pad, 1
	else
	write (u, '(A25,I1)') "extra use_cms " // pad, 0
	end if
	write (u, '(A25,I1)') "extra me_cache " // pad, 0
	!!! Turn off calculation of 1/eps & 1/eps^2 poles in one-loop calculation
	!!! Not needed in FKS (or any numerical NLO subtraction scheme)
	write (u, '(A25,I1)') "extra IR_on " // pad, 0
	if (cfg%openloops_phs_tolerance > 0) then
	write (u, '(A25,A4,I0)') "extra psp_tolerance " // pad, "10e-", &
	cfg%openloops_phs_tolerance
	end if
	call check_extra_cmd (cfg%openloops_extra_cmd)
	write (u, '(A)') char (cfg%openloops_extra_cmd)
	if (cfg%openloops_allowed_libs /= '') then
	write (u, '(A25,A)') "extra allowed_libs" // pad, &
	char (cfg%openloops_allowed_libs)
	end if
	if (cfg%openloops_stability_log > 0) &
	write (u, '(A25,I1)') "extra stability_log " // pad, &
	cfg%openloops_stability_log
	end select
	if (full) then
	write (u, "(A)")
	write (u, "(A)") "# Process definitions"
	write (u, "(A)")
	end if
	if (cfg%debug_unstable) &
	write (u, '(A25,A)') "DebugUnstable " // pad, "True"
	write (u, *)
	node => cfg%processes
	do while (associated (node))
	write_process = .true.
	allocate (pdg_flv (size (node%pdg_in) + size (node%pdg_out)))
	do i = 1, size (node%pdg_in)
	pdg_flv (i) = node%pdg_in(i)%pdg
	end do
	do i = 1, size (node%pdg_out)
	pdg_flv (i + size (node%pdg_in)) = node%pdg_out(i)%pdg
	end do
	suffix_char = char (suffix)
	if (cfg%correction_type == BLHA_CT_EW .and. cfg%alphas_power > 0) then
	if ((suffix_char (1:5) == "_BORN" .and. .not. query_coupling_powers &
	(pdg_flv, cfg%alpha_power, cfg%alphas_power)) .or. &
	((suffix_char (1:4) == "_SUB" .or. suffix_char (1:5) == "_LOOP" .or. &
	suffix_char (1:6) == "_DGLAP") .and. (.not. (query_coupling_powers &
	(pdg_flv, cfg%alpha_power, cfg%alphas_power) .or. query_coupling_powers &
	(pdg_flv, cfg%alpha_power + 1, cfg%alphas_power - 1)) .or. &
	all (is_gluon (pdg_flv))))) then
	deallocate (pdg_flv)
	node => node%next
	cycle
	end if
	end if
	select case (node%amplitude_type)
	case (BLHA_AMP_LOOP); buf = "Loop"
	case (BLHA_AMP_COLOR_C); buf = "ccTree"
	case (BLHA_AMP_SPIN_C)
	if (cfg%mode == BLHA_MODE_OPENLOOPS) then
	buf = "sctree_polvect"
	+ else if (cfg%mode == BLHA_MODE_GOSAM) then
	+ buf = "scTree2"
	else
	buf = "scTree"
	end if
	case (BLHA_AMP_TREE); buf = "Tree"
	case (BLHA_AMP_LOOPINDUCED); buf = "LoopInduced"
	end select
	nlo3 = qcd_ew_interferences (pdg_flv) .and. &
	(node%amplitude_type == BLHA_AMP_COLOR_C .or. &
	node%amplitude_type == BLHA_AMP_SPIN_C) .and. &
	.not. query_coupling_powers (pdg_flv, cfg%alpha_power+2, cfg%alphas_power-2)
	if (write_process) then
	write (u, '(A25, A)') "AmplitudeType " // pad, char (buf)
	buf = ""
	if (cfg%correction_type == BLHA_CT_EW .and. cfg%alphas_power > 0 .and. &
	(suffix_char (1:4) == "_SUB" .or. suffix_char (1:5) == "_LOOP" &
	.or. suffix_char (1:6) == "_DGLAP")) then
	if (query_coupling_powers (pdg_flv, cfg%alpha_power, cfg%alphas_power) &
	.and. .not. nlo3) then
	write (u,'(A25,A)') "CorrectionType" // pad, "EW"
	select case (cfg%version)
	case (1)
	if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	"AlphasPower" // pad, int2char (cfg%alphas_power)
	if (cfg%alpha_power >= 0) write (u,'(A25,A)') &
	"AlphaPower " // pad, int2char (cfg%alpha_power)
	case (2)
	if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	"CouplingPower QCD " // pad, int2char (cfg%alphas_power)
	if (cfg%alpha_power >= 0) write (u, '(A25,A)') &
	"CouplingPower QED " // pad, int2char (cfg%alpha_power)
	end select
	else if (query_coupling_powers &
	(pdg_flv, cfg%alpha_power + 1, cfg%alphas_power - 1)) then
	write (u,'(A25,A)') "CorrectionType" // pad, "QCD"
	select case (cfg%version)
	case (1)
	if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	"AlphasPower" // pad, int2char (cfg%alphas_power - 1)
	if (cfg%alpha_power >= 0) write (u,'(A25,A)') &
	"AlphaPower " // pad, int2char (cfg%alpha_power + 1)
	case (2)
	if (cfg%alphas_power >= 0) write (u,'(A25,A)') &
	"CouplingPower QCD " // pad, int2char (cfg%alphas_power - 1)
	if (cfg%alpha_power >= 0) write (u, '(A25,A)') &
	"CouplingPower QED " // pad, int2char (cfg%alpha_power + 1)
	end select
	end if
	end if
	do i = 1, size (node%pdg_in)
	if (cfg%correction_type == BLHA_CT_EW .and. node%pdg_in(i)%pdg == PHOTON &
	.and. cfg%n_off_photons_is > 0) then
	if (cfg%ew_scheme == BLHA_EW_0) then
	call msg_fatal ("ew_scheme: 'alpha_0' or 'alpha_thompson' " &
	// "in combination", [ var_str ("with off-shell external photons " &
	// "is not consistent with FKS.")])
	end if
	write (pdg_char_extra, '(I5)') PHOTON_OFFSHELL
	buf = (buf // pdg_char_extra) // " "
	else
	call node%pdg_in(i)%write_pdg (pdg_char)
	if (node%pdg_in(i)%polarized) then
	call node%pdg_in(i)%write_helicity (hel_char)
	buf = (buf // pdg_char // hel_char) // " "
	else
	buf = (buf // pdg_char) // " "
	end if
	end if
	end do
	buf = buf // "-> "
	do i = 1, size (node%pdg_out)
	if (cfg%correction_type == BLHA_CT_EW .and. node%pdg_out(i)%pdg == PHOTON &
	.and. cfg%n_off_photons_fs > 0) then
	if (cfg%ew_scheme == BLHA_EW_0) then
	call msg_fatal ("ew_scheme: 'alpha_0' or 'alpha_thompson' " &
	// "in combination with off-shell external photons " &
	// "is not consistent with FKS. Try a different one.")
	end if
	write (pdg_char_extra, '(I5)') PHOTON_OFFSHELL
	buf = (buf // pdg_char_extra) // " "
	else
	call node%pdg_out(i)%write_pdg (pdg_char)
	buf = (buf // pdg_char) // " "
	end if
	end do
	write (u, "(A)") char (trim (buf))
	write (u, *)
	end if
	deallocate (pdg_flv)
	node => node%next
	end do
	end subroutine blha_configuration_write

	@ %def blha_configuration_write
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Module definition}

	These modules implement the communication with one loop matrix element providers
	according to the Binoth LesHouches Accord Interface. The actual matrix
	element(s) are loaded as a dynamic library.

	This module defines the common OLP-interfaces defined through the Binoth Les-Houches
	accord.

	<<[[blha_olp_interfaces.f90]]>>=
	<<File header>>

	module blha_olp_interfaces

	use, intrinsic :: iso_c_binding !NODEP!
	use, intrinsic :: iso_fortran_env

	use kinds
	<<Use strings>>
	use os_interface
	use lorentz
	use interactions
	use model_data

	use prclib_interfaces
	use process_libraries
	use prc_core_def
	use prc_core
	use prc_external
	use blha_config

	<<Standard module head>>

	<<BLHA OLP interfaces: public>>

	<<BLHA OLP interfaces: public parameters>>

	<<BLHA OLP interfaces: types>>

	<<BLHA OLP interfaces: interfaces>>

	interface
	<<BLHA OLP interfaces: sub interfaces>>
	end interface

	end module blha_olp_interfaces

	@ %def module blha_olp_interfaces
	@
	<<[[blha_olp_interfaces_sub.f90]]>>=
	<<File header>>

	submodule (blha_olp_interfaces) blha_olp_interfaces_s

	<<Use debug>>
	use constants
	use numeric_utils, only: vanishes
	use numeric_utils, only: extend_integer_array, crop_integer_array
	use io_units
	use string_utils
	use physics_defs
	use diagnostics
	use sm_qcd
	use flavors
	use pdg_arrays, only: is_gluon, is_quark, qcd_ew_interferences

	implicit none

	<<BLHA OLP interfaces: parameters>>

	contains

	<<BLHA OLP interfaces: procedures>>

	end submodule blha_olp_interfaces_s

	@ %def blha_olp_interfaces_s
	@
	<<BLHA OLP interfaces: public>>=
	public :: blha_template_t
	<<BLHA OLP interfaces: types>>=
	type :: blha_template_t
	integer :: I_BORN = 0
	integer :: I_REAL = 1
	integer :: I_LOOP = 2
	integer :: I_SUB = 3
	integer :: I_DGLAP = 4
	logical, dimension(0:4) :: compute_component
	logical :: include_polarizations = .false.
	logical :: switch_off_muon_yukawas = .false.
	logical :: use_internal_color_correlations = .true.
	real(default) :: external_top_yukawa = -1._default
	integer :: ew_scheme
	integer :: loop_method = BLHA_MODE_GENERIC
	contains
	<<BLHA OLP interfaces: blha template: TBP>>
	end type blha_template_t

	@ %def blha_template_t
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: write => blha_template_write
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_template_write (blha_template, unit)
	class(blha_template_t), intent(in) :: blha_template
	integer, intent(in), optional :: unit
	end subroutine blha_template_write
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_template_write (blha_template, unit)
	class(blha_template_t), intent(in) :: blha_template
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u,"(A,4(L1))") "Compute components: ", &
	blha_template%compute_component
	write (u,"(A,L1)") "Include polarizations: ", &
	blha_template%include_polarizations
	write (u,"(A,L1)") "Switch off muon yukawas: ", &
	blha_template%switch_off_muon_yukawas
	write (u,"(A,L1)") "Use internal color correlations: ", &
	blha_template%use_internal_color_correlations
	end subroutine blha_template_write

	@ %def blha_template_write
	@ Compute the total number of used helicity states for the given particle PDG
	codes, given a model. Applies only if polarization is supported. This
	yields the [[n_hel]] value as required below.
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: get_n_hel => blha_template_get_n_hel
	<<BLHA OLP interfaces: sub interfaces>>=
	module function blha_template_get_n_hel (blha_template, pdg, model) result (n_hel)
	class(blha_template_t), intent(in) :: blha_template
	integer, dimension(:), intent(in) :: pdg
	class(model_data_t), intent(in), target :: model
	integer :: n_hel
	end function blha_template_get_n_hel
	<<BLHA OLP interfaces: procedures>>=
	module function blha_template_get_n_hel (blha_template, pdg, model) result (n_hel)
	class(blha_template_t), intent(in) :: blha_template
	integer, dimension(:), intent(in) :: pdg
	class(model_data_t), intent(in), target :: model
	integer :: n_hel
	type(flavor_t) :: flv
	integer :: f
	n_hel = 1
	if (blha_template%include_polarizations) then
	do f = 1, size (pdg)
	call flv%init (pdg(f), model)
	n_hel = n_hel * flv%get_multiplicity ()
	end do
	end if
	end function blha_template_get_n_hel

	@ %def blha_template_get_n_hel
	@
	<<BLHA OLP interfaces: parameters>>=
	integer, parameter :: I_ALPHA_0 = 1
	integer, parameter :: I_GF = 2
	integer, parameter :: I_ALPHA_MZ = 3
	integer, parameter :: I_ALPHA_INTERNAL = 4
	integer, parameter :: I_SW2 = 5

	<<BLHA OLP interfaces: public>>=
	public :: prc_blha_t
	<<BLHA OLP interfaces: types>>=
	type, abstract, extends (prc_external_t) :: prc_blha_t
	integer :: n_particles
	integer :: n_hel
	integer :: n_proc
	integer, dimension(:, :), allocatable :: i_tree, i_spin_c, i_color_c
	integer, dimension(:, :), allocatable :: i_virt
	integer, dimension(:, :), allocatable :: i_hel
	logical, dimension(5) :: ew_parameter_mask
	integer :: sqme_tree_pos
	contains
	<<BLHA OLP interfaces: prc blha: TBP>>
	end type prc_blha_t

	@ %def prc_blha_t
	@
	Obviously, this process-core type uses the BLHA interface.
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure, nopass :: uses_blha => prc_blha_uses_blha
	<<BLHA OLP interfaces: sub interfaces>>=
	module function prc_blha_uses_blha () result (flag)
	logical :: flag
	end function prc_blha_uses_blha
	<<BLHA OLP interfaces: procedures>>=
	module function prc_blha_uses_blha () result (flag)
	logical :: flag
	flag = .true.
	end function prc_blha_uses_blha

	@ %def prc_blha_uses_blha
	@
	<<BLHA OLP interfaces: public>>=
	public :: blha_driver_t
	<<BLHA OLP interfaces: types>>=
	type, abstract, extends (prc_external_driver_t) :: blha_driver_t
	type(string_t) :: contract_file
	type(string_t) :: nlo_suffix
	logical :: include_polarizations = .false.
	logical :: switch_off_muon_yukawas = .false.
	real(default) :: external_top_yukawa = -1.0
	procedure(olp_start),nopass, pointer :: &
	blha_olp_start => null ()
	procedure(olp_eval), nopass, pointer :: &
	blha_olp_eval => null()
	procedure(olp_info), nopass, pointer :: &
	blha_olp_info => null ()
	procedure(olp_set_parameter), nopass, pointer :: &
	blha_olp_set_parameter => null ()
	procedure(olp_eval2), nopass, pointer :: &
	blha_olp_eval2 => null ()
	procedure(olp_option), nopass, pointer :: &
	blha_olp_option => null ()
	procedure(olp_polvec), nopass, pointer :: &
	blha_olp_polvec => null ()
	procedure(olp_finalize), nopass, pointer :: &
	blha_olp_finalize => null ()
	procedure(olp_print_parameter), nopass, pointer :: &
	blha_olp_print_parameter => null ()
	contains
	<<BLHA OLP interfaces: blha driver: TBP>>
	end type blha_driver_t

	@
	@ %def blha_driver_t
	<<BLHA OLP interfaces: public>>=
	public :: prc_blha_writer_t
	<<BLHA OLP interfaces: types>>=
	type, abstract, extends (prc_external_writer_t) :: prc_blha_writer_t
	type(blha_configuration_t) :: blha_cfg
	contains
	<<BLHA OLP interfaces: blha writer: TBP>>
	end type prc_blha_writer_t

	@
	@ %def prc_blha_writer_t
	<<BLHA OLP interfaces: public>>=
	public :: blha_def_t
	<<BLHA OLP interfaces: types>>=
	type, abstract, extends (prc_external_def_t) :: blha_def_t
	type(string_t) :: suffix
	contains
	<<BLHA OLP interfaces: blha def: TBP>>
	end type blha_def_t

	@ %def blha_def_t
	@
	<<BLHA OLP interfaces: public>>=
	public :: blha_state_t
	<<BLHA OLP interfaces: types>>=
	type, abstract, extends (prc_external_state_t) :: blha_state_t
	contains
	<<BLHA OLP interfaces: blha state: TBP>>
	end type blha_state_t

	@ %def blha_state_t
	@
	<<BLHA OLP interfaces: blha state: TBP>>=
	procedure :: reset_new_kinematics => blha_state_reset_new_kinematics
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_state_reset_new_kinematics (object)
	class(blha_state_t), intent(inout) :: object
	end subroutine blha_state_reset_new_kinematics
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_state_reset_new_kinematics (object)
	class(blha_state_t), intent(inout) :: object
	object%new_kinematics = .true.
	end subroutine blha_state_reset_new_kinematics

	@ %def blha_state_reset_new_kinematics
	@
	<<BLHA OLP interfaces: public parameters>>=
	integer, parameter, public :: OLP_PARAMETER_LIMIT = 10
	integer, parameter, public :: OLP_MOMENTUM_LIMIT = 50
	integer, parameter, public :: OLP_RESULTS_LIMIT = 60

	<<BLHA OLP interfaces: public>>=
	public :: olp_start
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_start (contract_file_name, ierr) bind (C,name = "OLP_Start")
	import
	character(kind = c_char, len = 1), intent(in) :: contract_file_name
	integer(kind = c_int), intent(out) :: ierr
	end subroutine olp_start
	end interface

	@ %def olp_start_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_eval
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_eval (label, momenta, mu, parameters, res) &
	bind (C, name = "OLP_EvalSubProcess")
	import
	integer(kind = c_int), value, intent(in) :: label
	real(kind = c_double), value, intent(in) :: mu
	real(kind = c_double), dimension(OLP_MOMENTUM_LIMIT), intent(in) :: &
	momenta
	real(kind = c_double), dimension(OLP_PARAMETER_LIMIT), intent(in) :: &
	parameters
	real(kind = c_double), dimension(OLP_RESULTS_LIMIT), intent(out) :: res
	end subroutine olp_eval
	end interface

	@ %def olp_eval interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_info
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_info (olp_file, olp_version, message) bind(C)
	import
	character(kind = c_char), intent(inout), dimension(15) :: olp_file
	character(kind = c_char), intent(inout), dimension(15) :: olp_version
	character(kind = c_char), intent(inout), dimension(255) :: message
	end subroutine olp_info
	end interface

	@ %def olp_info interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_set_parameter
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_set_parameter &
	(variable_name, real_part, complex_part, success) bind(C)
	import
	character(kind = c_char,len = 1), intent(in) :: variable_name
	real(kind = c_double), intent(in) :: real_part, complex_part
	integer(kind = c_int), intent(out) :: success
	end subroutine olp_set_parameter
	end interface

	@ %def olp_set_parameter_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_eval2
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_eval2 (label, momenta, mu, res, acc) bind(C)
	import
	integer(kind = c_int), intent(in) :: label
	real(kind = c_double), intent(in) :: mu
	real(kind = c_double), dimension(OLP_MOMENTUM_LIMIT), intent(in) :: momenta
	real(kind = c_double), dimension(OLP_RESULTS_LIMIT), intent(out) :: res
	real(kind = c_double), intent(out) :: acc
	end subroutine olp_eval2
	end interface

	@ %def olp_eval2 interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_option
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_option (line, stat) bind(C)
	import
	character(kind = c_char, len=1), intent(in) :: line
	integer(kind = c_int), intent(out) :: stat
	end subroutine
	end interface

	@ %def olp_option_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_polvec
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_polvec (p, q, eps) bind(C)
	import
	real(kind = c_double), dimension(0:3), intent(in) :: p, q
	real(kind = c_double), dimension(0:7), intent(out) :: eps
	end subroutine
	end interface

	@ %def olp_polvec_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_finalize
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_finalize () bind(C)
	import
	end subroutine olp_finalize
	end interface

	@ %def olp_finalize_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: olp_print_parameter
	<<BLHA OLP interfaces: interfaces>>=
	interface
	subroutine olp_print_parameter (filename) bind(C)
	import
	character(kind = c_char, len = 1), intent(in) :: filename
	end subroutine olp_print_parameter
	end interface

	@ %def olp_print_parameter_interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: blha_result_array_size
	<<BLHA OLP interfaces: sub interfaces>>=
	pure module function blha_result_array_size &
	(n_part, amp_type) result (rsize)
	integer, intent(in) :: n_part, amp_type
	integer :: rsize
	end function blha_result_array_size
	<<BLHA OLP interfaces: procedures>>=
	pure module function blha_result_array_size &
	(n_part, amp_type) result (rsize)
	integer, intent(in) :: n_part, amp_type
	integer :: rsize
	select case (amp_type)
	case (BLHA_AMP_TREE)
	rsize = 1
	case (BLHA_AMP_LOOP)
	rsize = 4
	case (BLHA_AMP_COLOR_C)
	rsize = n_part * (n_part - 1) / 2
	case (BLHA_AMP_SPIN_C)
	rsize = 2 * n_part**2
	case (BLHA_AMP_LOOPINDUCED)
	rsize = 1
	case default
	rsize = 0
	end select
	end function blha_result_array_size

	@ %def blha_result_array_size
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: create_momentum_array => prc_blha_create_momentum_array
	<<BLHA OLP interfaces: sub interfaces>>=
	module function prc_blha_create_momentum_array (object, p) result (mom)
	class(prc_blha_t), intent(in) :: object
	type(vector4_t), intent(in), dimension(:) :: p
	real(double), dimension(5*object%n_particles) :: mom
	end function prc_blha_create_momentum_array
	<<BLHA OLP interfaces: procedures>>=
	module function prc_blha_create_momentum_array (object, p) result (mom)
	class(prc_blha_t), intent(in) :: object
	type(vector4_t), intent(in), dimension(:) :: p
	real(double), dimension(5*object%n_particles) :: mom
	integer :: n, i, k

	n = size (p)
	if (n > 10) call msg_fatal ("Number of external particles exceeds" &
	// "size of BLHA-internal momentum array")

	mom = zero
	k = 1
	do i = 1, n
	mom(k : k + 3) = vector4_get_components (p(i))
	mom(k + 4) = invariant_mass (p(i))
	k = k + 5
	end do
	end function prc_blha_create_momentum_array

	@ %def prc_blha_create_momentum_array
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: init => blha_template_init
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_template_init (template, requires_polarizations, &
	switch_off_muon_yukawas, external_top_yukawa, ew_scheme)
	class(blha_template_t), intent(inout) :: template
	logical, intent(in) :: requires_polarizations, switch_off_muon_yukawas
	real(default), intent(in) :: external_top_yukawa
	type(string_t), intent(in) :: ew_scheme
	end subroutine blha_template_init
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_template_init (template, requires_polarizations, &
	switch_off_muon_yukawas, external_top_yukawa, ew_scheme)
	class(blha_template_t), intent(inout) :: template
	logical, intent(in) :: requires_polarizations, switch_off_muon_yukawas
	real(default), intent(in) :: external_top_yukawa
	type(string_t), intent(in) :: ew_scheme
	template%compute_component = .false.
	template%include_polarizations = requires_polarizations
	template%switch_off_muon_yukawas = switch_off_muon_yukawas
	template%external_top_yukawa = external_top_yukawa
	template%ew_scheme = ew_scheme_string_to_int (ew_scheme)
	end subroutine blha_template_init

	@ %def blha_template_init
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: set_born => blha_template_set_born
	procedure :: set_real_trees => blha_template_set_real_trees
	procedure :: set_loop => blha_template_set_loop
	procedure :: set_subtraction => blha_template_set_subtraction
	procedure :: set_dglap => blha_template_set_dglap
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_template_set_born (template)
	class(blha_template_t), intent(inout) :: template
	end subroutine blha_template_set_born
	module subroutine blha_template_set_real_trees (template)
	class(blha_template_t), intent(inout) :: template
	end subroutine blha_template_set_real_trees
	module subroutine blha_template_set_loop (template)
	class(blha_template_t), intent(inout) :: template
	end subroutine blha_template_set_loop
	module subroutine blha_template_set_subtraction (template)
	class(blha_template_t), intent(inout) :: template
	end subroutine blha_template_set_subtraction
	module subroutine blha_template_set_dglap (template)
	class(blha_template_t), intent(inout) :: template
	end subroutine blha_template_set_dglap
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_template_set_born (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component (template%I_BORN) = .true.
	end subroutine blha_template_set_born

	module subroutine blha_template_set_real_trees (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component (template%I_REAL) = .true.
	end subroutine blha_template_set_real_trees

	module subroutine blha_template_set_loop (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component(template%I_LOOP) = .true.
	end subroutine blha_template_set_loop

	module subroutine blha_template_set_subtraction (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component (template%I_SUB) = .true.
	end subroutine blha_template_set_subtraction

	module subroutine blha_template_set_dglap (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component (template%I_DGLAP) = .true.
	end subroutine blha_template_set_dglap

	@ %def blha_template_set_components
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: set_internal_color_correlations &
	=> blha_template_set_internal_color_correlations
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_template_set_internal_color_correlations (template)
	class(blha_template_t), intent(inout) :: template
	end subroutine blha_template_set_internal_color_correlations
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_template_set_internal_color_correlations (template)
	class(blha_template_t), intent(inout) :: template
	template%use_internal_color_correlations = .true.
	end subroutine blha_template_set_internal_color_correlations

	@ %def blha_template_set_internal_color_correlations
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: get_internal_color_correlations &
	=> blha_template_get_internal_color_correlations
	<<BLHA OLP interfaces: sub interfaces>>=
	pure module function blha_template_get_internal_color_correlations &
	(template) result (val)
	logical :: val
	class(blha_template_t), intent(in) :: template
	end function blha_template_get_internal_color_correlations
	<<BLHA OLP interfaces: procedures>>=
	pure module function blha_template_get_internal_color_correlations &
	(template) result (val)
	logical :: val
	class(blha_template_t), intent(in) :: template
	val = template%use_internal_color_correlations
	end function blha_template_get_internal_color_correlations

	@ %def blha_template_use_internal_color_correlations
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: compute_born => blha_template_compute_born
	procedure :: compute_real_trees => blha_template_compute_real_trees
	procedure :: compute_loop => blha_template_compute_loop
	procedure :: compute_subtraction => blha_template_compute_subtraction
	procedure :: compute_dglap => blha_template_compute_dglap
	<<BLHA OLP interfaces: sub interfaces>>=
	pure module function blha_template_compute_born (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	end function blha_template_compute_born
	pure module function blha_template_compute_real_trees (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	end function blha_template_compute_real_trees
	pure module function blha_template_compute_loop (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	end function blha_template_compute_loop
	pure module function blha_template_compute_subtraction (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	end function blha_template_compute_subtraction
	pure module function blha_template_compute_dglap (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	end function blha_template_compute_dglap
	<<BLHA OLP interfaces: procedures>>=
	pure module function blha_template_compute_born (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = template%compute_component (template%I_BORN)
	end function blha_template_compute_born

	pure module function blha_template_compute_real_trees (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = template%compute_component (template%I_REAL)
	end function blha_template_compute_real_trees

	pure module function blha_template_compute_loop (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = template%compute_component (template%I_LOOP)
	end function blha_template_compute_loop

	pure module function blha_template_compute_subtraction (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = template%compute_component (template%I_SUB)
	end function blha_template_compute_subtraction

	pure module function blha_template_compute_dglap (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = template%compute_component (template%I_DGLAP)
	end function blha_template_compute_dglap

	@ %def blha_template_compute
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: set_loop_method => blha_template_set_loop_method
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_template_set_loop_method (template, master)
	class(blha_template_t), intent(inout) :: template
	class(blha_master_t), intent(in) :: master
	end subroutine blha_template_set_loop_method
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_template_set_loop_method (template, master)
	class(blha_template_t), intent(inout) :: template
	class(blha_master_t), intent(in) :: master
	template%loop_method = master%blha_mode(1)
	end subroutine blha_template_set_loop_method
	@ %def blha_template_set_loop_method
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: check => blha_template_check
	<<BLHA OLP interfaces: sub interfaces>>=
	module function blha_template_check (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	end function blha_template_check
	<<BLHA OLP interfaces: procedures>>=
	module function blha_template_check (template) result (val)
	class(blha_template_t), intent(in) :: template
	logical :: val
	val = count (template%compute_component) == 1
	end function blha_template_check

	@ %def blha_template_check
	@
	<<BLHA OLP interfaces: blha template: TBP>>=
	procedure :: reset => blha_template_reset
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_template_reset (template)
	class(blha_template_t), intent(inout) :: template
	end subroutine blha_template_reset
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_template_reset (template)
	class(blha_template_t), intent(inout) :: template
	template%compute_component = .false.
	end subroutine blha_template_reset

	@ %def blha_template_reset
	@
	<<BLHA OLP interfaces: blha writer: TBP>>=
	procedure :: write => prc_blha_writer_write
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_writer_write (writer, unit)
	class(prc_blha_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	end subroutine prc_blha_writer_write
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_writer_write (writer, unit)
	class(prc_blha_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	write (unit, "(1x,A)") char (writer%get_process_string ())
	end subroutine prc_blha_writer_write

	@
	@ %def prc_blha_writer_write
	<<BLHA OLP interfaces: blha writer: TBP>>=
	procedure :: get_process_string => prc_blha_writer_get_process_string
	<<BLHA OLP interfaces: sub interfaces>>=
	module function prc_blha_writer_get_process_string (writer) result (s_proc)
	class(prc_blha_writer_t), intent(in) :: writer
	type(string_t) :: s_proc
	end function prc_blha_writer_get_process_string
	<<BLHA OLP interfaces: procedures>>=
	module function prc_blha_writer_get_process_string (writer) result (s_proc)
	class(prc_blha_writer_t), intent(in) :: writer
	type(string_t) :: s_proc
	s_proc = var_str ("")
	end function prc_blha_writer_get_process_string

	@ %def prc_blha_writer_get_process_string
	@
	<<BLHA OLP interfaces: blha writer: TBP>>=
	procedure :: get_n_proc => prc_blha_writer_get_n_proc
	<<BLHA OLP interfaces: sub interfaces>>=
	module function prc_blha_writer_get_n_proc (writer) result (n_proc)
	class(prc_blha_writer_t), intent(in) :: writer
	integer :: n_proc
	end function prc_blha_writer_get_n_proc
	<<BLHA OLP interfaces: procedures>>=
	module function prc_blha_writer_get_n_proc (writer) result (n_proc)
	class(prc_blha_writer_t), intent(in) :: writer
	integer :: n_proc
	n_proc = blha_configuration_get_n_proc (writer%blha_cfg)
	end function prc_blha_writer_get_n_proc

	@ %def prc_blha_writer_get_n_proc
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_set_GF), deferred :: &
	set_GF
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_set_GF (driver, GF)
	import
	class(blha_driver_t), intent(inout) :: driver
	real(default), intent(in) :: GF
	end subroutine blha_driver_set_GF
	end interface

	@ %def blha_driver_set_GF
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_set_alpha_s), deferred :: &
	set_alpha_s
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_set_alpha_s (driver, alpha_s)
	import
	class(blha_driver_t), intent(in) :: driver
	real(default), intent(in) :: alpha_s
	end subroutine blha_driver_set_alpha_s
	end interface

	@ %def set_alpha_s interface
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_set_weinberg_angle), deferred :: &
	set_weinberg_angle
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_set_weinberg_angle (driver, sw2)
	import
	class(blha_driver_t), intent(inout) :: driver
	real(default), intent(in) :: sw2
	end subroutine blha_driver_set_weinberg_angle
	end interface

	@ %def blha_driver_set_weinberg_angle
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_set_alpha_qed), deferred :: set_alpha_qed
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_set_alpha_qed (driver, alpha)
	import
	class(blha_driver_t), intent(inout) :: driver
	real(default), intent(in) :: alpha
	end subroutine blha_driver_set_alpha_qed
	end interface

	@ %def blha_driver_set_alpha_qed
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	+ procedure(blha_driver_set_ufo_parameter), deferred :: set_ufo_parameter
	+<<BLHA OLP interfaces: interfaces>>=
	+ abstract interface
	+ subroutine blha_driver_set_ufo_parameter (driver, par_name, ufo_par)
	+ import
	+ class(blha_driver_t), intent(inout) :: driver
	+ type(string_t), intent(in) :: par_name
	+ real(default), intent(in) :: ufo_par
	+ end subroutine blha_driver_set_ufo_parameter
	+ end interface
	+
	+@ %def blha_driver_set_ufo_parameter
	+@
	+<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_print_alpha_s), deferred :: &
	print_alpha_s
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_print_alpha_s (object)
	import
	class(blha_driver_t), intent(in) :: object
	end subroutine blha_driver_print_alpha_s
	end interface

	@ %def print_alpha_s interface
	@
	<<BLHA OLP interfaces: public>>=
	public :: parameter_error_message
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine parameter_error_message (par, subr)
	type(string_t), intent(in) :: par, subr
	end subroutine parameter_error_message
	<<BLHA OLP interfaces: procedures>>=
	module subroutine parameter_error_message (par, subr)
	type(string_t), intent(in) :: par, subr
	type(string_t) :: message
	message = "Setting of parameter " // par &
	// "failed in " // subr // "!"
	call msg_fatal (char (message))
	end subroutine parameter_error_message

	@ %def parameter_error_message
	@
	<<BLHA OLP interfaces: public>>=
	public :: ew_parameter_error_message
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine ew_parameter_error_message (par)
	type(string_t), intent(in) :: par
	end subroutine ew_parameter_error_message
	<<BLHA OLP interfaces: procedures>>=
	module subroutine ew_parameter_error_message (par)
	type(string_t), intent(in) :: par
	type(string_t) :: message
	message = "Setting of parameter " // par &
	// "failed. This happens because the chosen " &
	// "EWScheme in the BLHA file does not fit " &
	// "your parameter choice"
	call msg_fatal (char (message))
	end subroutine ew_parameter_error_message

	@ %def ew_parameter_error_message
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure :: set_mass_and_width => blha_driver_set_mass_and_width
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_driver_set_mass_and_width &
	(driver, i_pdg, mass, width)
	class(blha_driver_t), intent(inout) :: driver
	integer, intent(in) :: i_pdg
	real(default), intent(in), optional :: mass
	real(default), intent(in), optional :: width
	end subroutine blha_driver_set_mass_and_width
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_driver_set_mass_and_width &
	(driver, i_pdg, mass, width)
	class(blha_driver_t), intent(inout) :: driver
	integer, intent(in) :: i_pdg
	real(default), intent(in), optional :: mass
	real(default), intent(in), optional :: width
	type(string_t) :: buf
	character(kind=c_char,len=20) :: c_string
	integer :: ierr
	if (present (mass)) then
	buf = 'mass(' // str (abs(i_pdg)) // ')'
	c_string = char(buf) // c_null_char
	call driver%blha_olp_set_parameter &
	(c_string, dble(mass), 0._double, ierr)
	if (ierr == 0) then
	buf = "BLHA driver: Attempt to set mass of particle " // &
	str (abs(i_pdg)) // "failed"
	call msg_fatal (char(buf))
	end if
	end if
	if (present (width)) then
	buf = 'width(' // str (abs(i_pdg)) // ')'
	c_string = char(buf)//c_null_char
	call driver%blha_olp_set_parameter &
	(c_string, dble(width), 0._double, ierr)
	if (ierr == 0) then
	buf = "BLHA driver: Attempt to set width of particle " // &
	str (abs(i_pdg)) // "failed"
	call msg_fatal (char(buf))
	end if
	end if
	end subroutine blha_driver_set_mass_and_width

	@ %def blha_driver_set_mass_and_width
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure(blha_driver_init_dlaccess_to_library), deferred :: &
	init_dlaccess_to_library
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine blha_driver_init_dlaccess_to_library &
	(object, os_data, dlaccess, success)
	import
	class(blha_driver_t), intent(in) :: object
	type(os_data_t), intent(in) :: os_data
	type(dlaccess_t), intent(out) :: dlaccess
	logical, intent(out) :: success
	end subroutine blha_driver_init_dlaccess_to_library
	end interface

	@ %def interface blha_driver_init_dlaccess_to_library
	@
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure :: load => blha_driver_load
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_driver_load (object, os_data, success)
	class(blha_driver_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	logical, intent(out) :: success
	end subroutine blha_driver_load
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_driver_load (object, os_data, success)
	class(blha_driver_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	logical, intent(out) :: success
	type(dlaccess_t) :: dlaccess
	type(c_funptr) :: c_fptr
	logical :: init_success

	call object%init_dlaccess_to_library (os_data, dlaccess, init_success)

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_Start"))
	call c_f_procpointer (c_fptr, object%blha_olp_start)
	call check_for_error (var_str ("OLP_Start"))

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_EvalSubProcess"))
	call c_f_procpointer (c_fptr, object%blha_olp_eval)
	call check_for_error (var_str ("OLP_EvalSubProcess"))

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_Info"))
	call c_f_procpointer (c_fptr, object%blha_olp_info)
	call check_for_error (var_str ("OLP_Info"))

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_SetParameter"))
	call c_f_procpointer (c_fptr, object%blha_olp_set_parameter)
	call check_for_error (var_str ("OLP_SetParameter"))

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_EvalSubProcess2"))
	call c_f_procpointer (c_fptr, object%blha_olp_eval2)
	call check_for_error (var_str ("OLP_EvalSubProcess2"))

	!!! The following three functions are not implemented in OpenLoops.
	!!! In another BLHA provider, they need to be implemented separately.

	!!! c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_Option"))
	!!! call c_f_procpointer (c_fptr, object%blha_olp_option)
	!!! call check_for_error (var_str ("OLP_Option"))

	!!! c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_Polvec"))
	!!! call c_f_procpointer (c_fptr, object%blha_olp_polvec)
	!!! call check_for_error (var_str ("OLP_Polvec"))

	!!! c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_Finalize"))
	!!! call c_f_procpointer (c_fptr, object%blha_olp_finalize)
	!!! call check_for_error (var_str ("OLP_Finalize"))

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("OLP_PrintParameter"))
	call c_f_procpointer (c_fptr, object%blha_olp_print_parameter)
	call check_for_error (var_str ("OLP_PrintParameter"))

	success = .true.
	contains
	subroutine check_for_error (function_name)
	type(string_t), intent(in) :: function_name
	if (dlaccess_has_error (dlaccess)) &
	call msg_fatal (char ("Loading of " // function_name // " failed!"))
	end subroutine check_for_error
	end subroutine blha_driver_load

	@ %def blha_driver_load
	@
	<<BLHA OLP interfaces: parameters>>=
	integer, parameter :: LEN_MAX_FLAVOR_STRING = 100
	integer, parameter :: N_MAX_FLAVORS = 100
	<<BLHA OLP interfaces: blha driver: TBP>>=
	procedure :: read_contract_file => blha_driver_read_contract_file
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_driver_read_contract_file (driver, flavors, &
	amp_type, flv_index, hel_index, label, helicities)
	class(blha_driver_t), intent(inout) :: driver
	integer, intent(in), dimension(:,:) :: flavors
	integer, intent(out), dimension(:), allocatable :: amp_type, &
	flv_index, hel_index, label
	integer, intent(out), dimension(:,:) :: helicities
	end subroutine blha_driver_read_contract_file
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_driver_read_contract_file (driver, flavors, &
	amp_type, flv_index, hel_index, label, helicities)
	class(blha_driver_t), intent(inout) :: driver
	integer, intent(in), dimension(:,:) :: flavors
	integer, intent(out), dimension(:), allocatable :: amp_type, &
	flv_index, hel_index, label
	integer, intent(out), dimension(:,:) :: helicities
	integer :: unit, filestat
	character(len=LEN_MAX_FLAVOR_STRING) :: rd_line
	logical :: read_flavor, give_warning
	integer :: label_count, i_flv, i
	integer :: i_hel, n_in
	integer :: i_next, n_entries
	integer, dimension(size(flavors, 1) + 2) :: i_array
	integer, dimension(size(flavors, 1) + 2) :: hel_array
	integer, dimension(size(flavors, 1)) :: flv_array
	integer, parameter :: NO_NUMBER = -1000
	integer, parameter :: PROC_NOT_FOUND = -1001
	integer, parameter :: list_incr = 50
	integer :: n_found
	allocate (amp_type (N_MAX_FLAVORS), flv_index (N_MAX_FLAVORS), &
	hel_index (N_MAX_FLAVORS), label (N_MAX_FLAVORS))
	amp_type = -1; flv_index = -1; hel_index = -1; label = -1
	helicities = 0
	n_in = size (helicities, dim = 2)
	n_entries = size (flavors, 1) + 2
	unit = free_unit ()
	open (unit, file = char (driver%contract_file), status="old")
	read_flavor = .false.
	label_count = 1
	i_hel = 1
	n_found = 0
	give_warning = .false.
	do
	read (unit, "(A)", iostat = filestat) rd_line
	if (filestat == iostat_end) then
	exit
	else
	if (rd_line(1:13) == 'AmplitudeType') then
	if (i_hel > 2 * n_in) i_hel = 1
	i_next = find_next_word_index (rd_line, 13)
	if (label_count > size (amp_type)) &
	call extend_integer_array (amp_type, list_incr)
	if (rd_line(i_next : i_next + 11) == 'LoopInduced') then
	amp_type(label_count) = BLHA_AMP_LOOPINDUCED
	else if (rd_line(i_next : i_next + 4) == 'Loop') then
	amp_type(label_count) = BLHA_AMP_LOOP
	else if (rd_line(i_next : i_next + 4) == 'Tree') then
	amp_type(label_count) = BLHA_AMP_TREE
	else if (rd_line(i_next : i_next + 6) == 'ccTree') then
	amp_type(label_count) = BLHA_AMP_COLOR_C
	else if (rd_line(i_next : i_next + 6) == 'scTree' .or. &
	- rd_line(i_next : i_next + 14) == 'sctree_polvect') then
	+ rd_line(i_next : i_next + 14) == 'sctree_polvect' .or. &
	+ rd_line(i_next : i_next + 7) == 'scTree2') then
	amp_type(label_count) = BLHA_AMP_SPIN_C
	else
	call msg_fatal ("AmplitudeType present but AmpType not known!")
	end if
	read_flavor = .true.
	else if (read_flavor .and. .not. (rd_line(1:13) == 'CouplingPower' &
	.or. rd_line(1:14) == 'CorrectionType')) then
	i_array = create_flavor_string (rd_line, n_entries)
	if (driver%include_polarizations) then
	hel_array = create_helicity_string (rd_line, n_entries)
	call check_helicity_array (hel_array, n_entries, n_in)
	else
	hel_array = 0
	end if
	if (.not. all (i_array == PROC_NOT_FOUND)) then
	do i_flv = 1, size (flavors, 2)
	flv_array = 0
	do i = 1, size (flv_array)
	if (i_array (i) == PHOTON_OFFSHELL .and. &
	flavors (i, i_flv) == PHOTON) then
	flv_array (i) = i_array (i)
	else
	flv_array (i) = flavors (i, i_flv)
	end if
	end do
	if (all (i_array (1 : n_entries - 2) == flv_array (:))) then
	if (label_count > size (label)) &
	call extend_integer_array (label, list_incr)
	label(label_count) = i_array (n_entries)
	if (label_count > size (flv_index)) &
	call extend_integer_array (flv_index, list_incr)
	flv_index (label_count) = i_flv
	if (label_count > size (hel_index)) &
	call extend_integer_array (hel_index, list_incr)
	hel_index (label_count) = i_hel
	if (driver%include_polarizations) then
	helicities (label(label_count), :) = hel_array (1:n_in)
	i_hel = i_hel + 1
	end if
	n_found = n_found + 1
	label_count = label_count + 1
	exit
	end if
	end do
	give_warning = .false.
	else
	give_warning = .true.
	end if
	read_flavor = .false.
	end if
	end if
	end do
	call crop_integer_array (amp_type, label_count-1)
	if (n_found == 0) then
	call msg_fatal ("The desired process has not been found ", &
	[var_str ("by the OLP-Provider. Maybe the value of alpha_power "), &
	var_str ("or alphas_power does not correspond to the process. "), &
	var_str ("If you are using OpenLoops, you can set the option "), &
	var_str ("openloops_verbosity to a value larger than 1 to obtain "), &
	var_str ("more information")])
	else if (give_warning) then
	call msg_warning ("Some processes have not been found in the OLC file.", &
	[var_str ("This is because these processes do not fit the required "), &
	var_str ("coupling alpha_power and alphas_power. Be aware that the "), &
	var_str ("results of this calculation are not necessarily an accurate "), &
	var_str ("description of the physics of interest.")])
	end if
	close(unit)

	contains

	function create_flavor_string (s, n_entries) result (i_array)
	character(len=LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(in) :: n_entries
	integer, dimension(n_entries) :: i_array
	integer :: k, current_position
	integer :: i_entry
	k = 1; current_position = 1
	do
	if (current_position > LEN_MAX_FLAVOR_STRING) &
	call msg_fatal ("Read OLC File: Current position exceeds maximum value")
	if (s(current_position:current_position) /= " ") then
	call create_flavor (s, i_entry, current_position)
	if (i_entry /= NO_NUMBER .and. i_entry /= PROC_NOT_FOUND) then
	i_array(k) = i_entry
	k = k + 1
	if (k > n_entries) then
	return
	else
	call increment_current_position (s, current_position)
	end if
	else if (i_entry == PROC_NOT_FOUND) then
	i_array = PROC_NOT_FOUND
	return
	else
	call increment_current_position (s, current_position)
	end if
	else
	call increment_current_position (s, current_position)
	end if
	end do
	end function create_flavor_string

	function create_helicity_string (s, n_entries) result (hel_array)
	character(len = LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(in) :: n_entries
	integer, dimension(n_entries) :: hel_array
	integer :: k, current_position
	integer :: hel
	k = 1; current_position = 1
	do
	if (current_position > LEN_MAX_FLAVOR_STRING) &
	call msg_fatal ("Read OLC File: Current position exceeds maximum value")
	if (s(current_position:current_position) /= " ") then
	call create_helicity (s, hel, current_position)
	if (hel >= -1 .and. hel <= 1) then
	hel_array(k) = hel
	k = k + 1
	if (k > n_entries) then
	return
	else
	call increment_current_position (s, current_position)
	end if
	else
	call increment_current_position (s, current_position)
	end if
	else
	call increment_current_position (s, current_position)
	end if
	end do
	end function create_helicity_string

	subroutine increment_current_position (s, current_position)
	character(len = LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(inout) :: current_position
	current_position = find_next_word_index (s, current_position)
	end subroutine increment_current_position

	subroutine get_next_buffer (s, current_position, buf, last_buffer_index)
	character(len = LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(inout) :: current_position
	character(len = 10), intent(out) :: buf
	integer, intent(out) :: last_buffer_index
	integer :: i
	i = 1; buf = ""
	do
	if (s(current_position:current_position) /= " ") then
	buf(i:i) = s(current_position:current_position)
	i = i + 1; current_position = current_position + 1
	else
	exit
	end if
	end do
	last_buffer_index = i
	end subroutine get_next_buffer

	function is_particle_buffer (buf, i) result (valid)
	logical :: valid
	character(len = 10), intent(in) :: buf
	integer, intent(in) :: i
	valid = (buf(1 : i - 1) /= "->" .and. buf(1 : i - 1) /= "\|" &
	.and. buf(1 : i - 1) /= "Process")
	end function is_particle_buffer

	subroutine create_flavor (s, i_particle, current_position)
	character(len=LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(out) :: i_particle
	integer, intent(inout) :: current_position
	character(len=10) :: buf
	integer :: i, last_buffer_index
	call get_next_buffer (s, current_position, buf, last_buffer_index)
	i = last_buffer_index
	if (is_particle_buffer (buf, i)) then
	call strip_helicity (buf, i)
	i_particle = read_ival (var_str (buf(1 : i - 1)))
	else if (buf(1 : i - 1) == "Process") then
	i_particle = PROC_NOT_FOUND
	else
	i_particle = NO_NUMBER
	end if
	end subroutine create_flavor

	subroutine create_helicity (s, helicity, current_position)
	character(len = LEN_MAX_FLAVOR_STRING), intent(in) :: s
	integer, intent(out) :: helicity
	integer, intent(inout) :: current_position
	character(len = 10) :: buf
	integer :: i, last_buffer_index
	logical :: success
	call get_next_buffer (s, current_position, buf, last_buffer_index)
	i = last_buffer_index
	if (is_particle_buffer (buf, i)) then
	call strip_flavor (buf, i, helicity, success)
	else
	helicity = 0
	end if
	end subroutine create_helicity

	subroutine strip_helicity (buf, i)
	character(len = 10), intent(in) :: buf
	integer, intent(inout) :: i
	integer :: i_last
	i_last = i - 1
	if (i_last < 4) return
	if (buf(i_last - 2 : i_last) == "(1)") then
	i = i - 3
	else if (buf(i_last - 3 : i_last) == "(-1)") then
	i = i - 4
	end if
	end subroutine strip_helicity

	subroutine strip_flavor (buf, i, helicity, success)
	character(len = 10), intent(in) :: buf
	integer, intent(in) :: i
	integer, intent(out) :: helicity
	logical, intent(out) :: success
	integer :: i_last
	i_last = i - 1
	helicity = 0
	if (i_last < 4) return
	if (buf(i_last - 2 : i_last) == "(1)") then
	helicity = 1
	success = .true.
	else if (buf(i_last - 3 : i_last) == "(-1)") then
	helicity = -1
	success = .true.
	else
	success = .false.
	end if
	end subroutine strip_flavor

	function find_next_word_index (word, i_start) result (i_next)
	character(len = LEN_MAX_FLAVOR_STRING), intent(in) :: word
	integer, intent(in) :: i_start
	integer :: i_next
	i_next = i_start + 1
	do
	if (word(i_next : i_next) /= " ") then
	exit
	else
	i_next = i_next + 1
	end if
	if (i_next > LEN_MAX_FLAVOR_STRING) &
	call msg_fatal ("Find next word: line limit exceeded")
	end do
	end function find_next_word_index

	subroutine check_helicity_array (hel_array, n_entries, n_in)
	integer, intent(in), dimension(:) :: hel_array
	integer, intent(in) :: n_entries, n_in
	integer :: n_particles, i
	logical :: valid
	n_particles = n_entries - 2
	!!! only allow polarisations for incoming fermions for now
	valid = all (hel_array (n_in + 1 : n_particles) == 0)
	do i = 1, n_in
	valid = valid .and. (hel_array(i) == 1 .or. hel_array(i) == -1)
	end do
	if (.not. valid) &
	call msg_fatal ("Invalid helicities encountered!")
	end subroutine check_helicity_array

	end subroutine blha_driver_read_contract_file

	@ %def blha_driver_read_contract_file
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_alpha_qed => prc_blha_set_alpha_qed
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_set_alpha_qed (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	end subroutine prc_blha_set_alpha_qed
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_set_alpha_qed (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	real(default) :: alpha

	alpha = one / model%get_real (var_str ('alpha_em_i'))

	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_alpha_qed (alpha)
	end select
	end subroutine prc_blha_set_alpha_qed

	@ %def prc_blha_set_alpha_qed
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_GF => prc_blha_set_GF
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_set_GF (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	end subroutine prc_blha_set_GF
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_set_GF (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	real(default) :: GF

	GF = model%get_real (var_str ('GF'))
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_GF (GF)
	end select
	end subroutine prc_blha_set_GF

	@ %def prc_blha_set_GF
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_weinberg_angle => prc_blha_set_weinberg_angle
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_set_weinberg_angle (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	end subroutine prc_blha_set_weinberg_angle
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_set_weinberg_angle (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	real(default) :: sw2

	sw2 = model%get_real (var_str ('sw2'))
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_weinberg_angle (sw2)
	end select
	end subroutine prc_blha_set_weinberg_angle

	@ %def prc_blha_set_weinberg_angle
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_electroweak_parameters => &
	prc_blha_set_electroweak_parameters
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_set_electroweak_parameters (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	end subroutine prc_blha_set_electroweak_parameters
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_set_electroweak_parameters (object, model)
	class(prc_blha_t), intent(inout) :: object
	type(model_data_t), intent(in), target :: model
	if (count (object%ew_parameter_mask) == 0) then
	call msg_fatal ("Cannot decide EW parameter setting: No scheme set!")
	else if (count (object%ew_parameter_mask) > 1) then
	call msg_fatal ("Cannot decide EW parameter setting: More than one scheme set!")
	end if
	if (object%ew_parameter_mask (I_ALPHA_INTERNAL)) call object%set_alpha_qed (model)
	if (object%ew_parameter_mask (I_GF)) call object%set_GF (model)
	if (object%ew_parameter_mask (I_SW2)) call object%set_weinberg_angle (model)
	end subroutine prc_blha_set_electroweak_parameters

	@ %def prc_blha_set_electrweak_parameters
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	+ procedure :: set_ufo_parameters => &
	+ prc_blha_set_ufo_parameters
	+<<BLHA OLP interfaces: sub interfaces>>=
	+ module subroutine prc_blha_set_ufo_parameters (object, model)
	+ class(prc_blha_t), intent(inout) :: object
	+ type(model_data_t), intent(in), target :: model
	+ end subroutine prc_blha_set_ufo_parameters
	+<<BLHA OLP interfaces: procedures>>=
	+ module subroutine prc_blha_set_ufo_parameters (object, model)
	+ class(prc_blha_t), intent(inout) :: object
	+ type(model_data_t), intent(in), target :: model
	+ class(modelpar_data_t), pointer :: par
	+ type(string_t) :: name
	+ integer :: i, ierr
	+ call model%set_non_zero_masses_as_input ()
	+ do i = 1, model%get_n_real ()
	+ par => model%get_par_real_ptr (i)
	+ if (par%is_input_par ()) then
	+ name = par%get_name ()
	+ select type (driver => object%driver)
	+ class is (blha_driver_t)
	+ call driver%set_ufo_parameter (name, model%get_real (name))
	+ end select
	+ end if
	+ end do
	+ end subroutine prc_blha_set_ufo_parameters
	+
	+@ %def prc_blha_set_ufo_parameters
	+@
	+<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: read_contract_file => prc_blha_read_contract_file
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_read_contract_file (object, flavors)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in), dimension(:,:) :: flavors
	end subroutine prc_blha_read_contract_file
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_read_contract_file (object, flavors)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in), dimension(:,:) :: flavors
	integer, dimension(:), allocatable :: amp_type, flv_index, hel_index, label
	integer, dimension(:,:), allocatable :: helicities
	integer :: i_proc, i_hel
	allocate (helicities (N_MAX_FLAVORS, object%data%n_in))
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%read_contract_file (flavors, amp_type, flv_index, &
	hel_index, label, helicities)
	end select
	object%n_proc = count (amp_type >= 0)
	do i_proc = 1, object%n_proc
	if (amp_type (i_proc) < 0) exit
	if (hel_index(i_proc) < 0 .and. object%includes_polarization ()) &
	call msg_bug ("Object includes polarization, but helicity index is undefined.")
	i_hel = hel_index (i_proc)
	select case (amp_type (i_proc))
	case (BLHA_AMP_TREE)
	if (allocated (object%i_tree)) then
	object%i_tree(flv_index(i_proc), i_hel) = label(i_proc)
	else
	call msg_fatal ("Tree matrix element present, &
	&but neither Born nor real indices are allocated!")
	end if
	case (BLHA_AMP_COLOR_C)
	if (allocated (object%i_color_c)) then
	object%i_color_c(flv_index(i_proc), i_hel) = label(i_proc)
	else
	call msg_fatal ("Color-correlated matrix element present, &
	&but cc-indices are not allocated!")
	end if
	case (BLHA_AMP_SPIN_C)
	if (allocated (object%i_spin_c)) then
	object%i_spin_c(flv_index(i_proc), i_hel) = label(i_proc)
	else
	call msg_fatal ("Spin-correlated matrix element present, &
	&but sc-indices are not allocated!")
	end if
	case (BLHA_AMP_LOOP)
	if (allocated (object%i_virt)) then
	object%i_virt(flv_index(i_proc), i_hel) = label(i_proc)
	else
	call msg_fatal ("Loop matrix element present, &
	&but virt-indices are not allocated!")
	end if
	case (BLHA_AMP_LOOPINDUCED)
	if (allocated (object%i_tree)) then
	object%i_tree(flv_index(i_proc), i_hel) = label(i_proc)
	else
	call msg_fatal ("Loop matrix element present, &
	&but neither Born nor real indices are allocated!")
	end if
	case default
	call msg_fatal ("Undefined amplitude type")
	end select
	if (allocated (object%i_hel)) &
	object%i_hel (i_proc, :) = helicities (label(i_proc), :)
	end do
	end subroutine prc_blha_read_contract_file

	@ %def prc_blha_read_contract_file
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: print_parameter_file => prc_blha_print_parameter_file
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_print_parameter_file (object, i_component)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_component
	end subroutine prc_blha_print_parameter_file
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_print_parameter_file (object, i_component)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_component
	type(string_t) :: filename

	select type (def => object%def)
	class is (blha_def_t)
	filename = def%basename // '_' // str (i_component) // '.olp_parameters'
	end select
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%blha_olp_print_parameter (char(filename)//c_null_char)
	end select
	end subroutine prc_blha_print_parameter_file

	@ %def prc_blha_print_parameter_file
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: compute_amplitude => prc_blha_compute_amplitude
	<<BLHA OLP interfaces: sub interfaces>>=
	module function prc_blha_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: core_state
	complex(default) :: amp
	end function prc_blha_compute_amplitude
	<<BLHA OLP interfaces: procedures>>=
	module function prc_blha_compute_amplitude &
	(object, j, p, f, h, c, fac_scale, ren_scale, alpha_qcd_forced, &
	core_state) result (amp)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: j
	type(vector4_t), dimension(:), intent(in) :: p
	integer, intent(in) :: f, h, c
	real(default), intent(in) :: fac_scale, ren_scale
	real(default), intent(in), allocatable :: alpha_qcd_forced
	class(prc_core_state_t), intent(inout), allocatable, optional :: core_state
	complex(default) :: amp
	select type (core_state)
	class is (blha_state_t)
	core_state%alpha_qcd = object%qcd%alpha%get (ren_scale)
	end select
	amp = zero
	end function prc_blha_compute_amplitude

	@ %def prc_blha_compute_amplitude
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: init_blha => prc_blha_init_blha
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_init_blha (object, blha_template, n_in, &
	n_particles, n_flv, n_hel)
	class(prc_blha_t), intent(inout) :: object
	type(blha_template_t), intent(in) :: blha_template
	integer, intent(in) :: n_in, n_particles, n_flv, n_hel
	end subroutine prc_blha_init_blha
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_init_blha (object, blha_template, n_in, &
	n_particles, n_flv, n_hel)
	class(prc_blha_t), intent(inout) :: object
	type(blha_template_t), intent(in) :: blha_template
	integer, intent(in) :: n_in, n_particles, n_flv, n_hel
	object%n_particles = n_particles
	object%n_flv = n_flv
	object%n_hel = n_hel
	if (blha_template%compute_loop ()) then
	if (blha_template%include_polarizations) then
	allocate (object%i_virt (n_flv, n_hel), &
	object%i_color_c (n_flv, n_hel))
	if (blha_template%use_internal_color_correlations) then
	allocate (object%i_hel (n_flv * n_in * n_hel * 2, n_in))
	else
	allocate (object%i_hel (n_flv * n_in * n_hel, n_in))
	end if
	else
	allocate (object%i_virt (n_flv, 1), object%i_color_c (n_flv, 1))
	end if
	object%i_virt = -1
	object%i_color_c = -1
	else if (blha_template%compute_subtraction ()) then
	if (blha_template%include_polarizations) then
	allocate (object%i_tree (n_flv, n_hel), &
	object%i_color_c (n_flv, n_hel), &
	object%i_spin_c (n_flv, n_hel), &
	object%i_hel (3 * (n_flv * n_hel * n_in), n_in))
	object%i_hel = 0
	else
	allocate (object%i_tree (n_flv, 1), object%i_color_c (n_flv, 1) , &
	object%i_spin_c (n_flv, 1))
	end if
	object%i_tree = -1
	object%i_color_c = -1
	object%i_spin_c = -1
	else if (blha_template%compute_dglap ()) then
	if (blha_template%include_polarizations) then
	allocate (object%i_tree (n_flv, n_hel), &
	object%i_color_c (n_flv, n_hel), &
	object%i_hel (3 * (n_flv * n_hel * n_in), n_in))
	object%i_hel = 0
	else
	allocate (object%i_tree (n_flv, 1), object%i_color_c (n_flv, 1))
	end if
	object%i_tree = -1
	object%i_color_c = -1
	else if (blha_template%compute_real_trees () .or. blha_template%compute_born ()) then
	if (blha_template%include_polarizations) then
	allocate (object%i_tree (n_flv, n_hel))
	allocate (object%i_hel (n_flv * n_hel * n_in, n_in))
	object%i_hel = 0
	else
	allocate (object%i_tree (n_flv, 1))
	end if
	object%i_tree = -1
	end if

	call object%init_ew_parameters (blha_template%ew_scheme)

	select type (driver => object%driver)
	class is (blha_driver_t)
	driver%include_polarizations = blha_template%include_polarizations
	driver%switch_off_muon_yukawas = blha_template%switch_off_muon_yukawas
	driver%external_top_yukawa = blha_template%external_top_yukawa
	end select
	end subroutine prc_blha_init_blha

	@ %def prc_blha_init_blha
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_mass_and_width => prc_blha_set_mass_and_width
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_set_mass_and_width (object, i_pdg, mass, width)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in) :: i_pdg
	real(default), intent(in) :: mass, width
	end subroutine prc_blha_set_mass_and_width
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_set_mass_and_width (object, i_pdg, mass, width)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in) :: i_pdg
	real(default), intent(in) :: mass, width
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_mass_and_width (i_pdg, mass, width)
	end select
	end subroutine prc_blha_set_mass_and_width

	@ %def prc_blha_set_mass_and_width
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_particle_properties => prc_blha_set_particle_properties
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_set_particle_properties (object, model)
	class(prc_blha_t), intent(inout) :: object
	class(model_data_t), intent(in), target :: model
	end subroutine prc_blha_set_particle_properties
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_set_particle_properties (object, model)
	class(prc_blha_t), intent(inout) :: object
	class(model_data_t), intent(in), target :: model
	integer :: i, i_pdg
	type(flavor_t) :: flv
	real(default) :: mass, width
	integer :: ierr
	real(default) :: top_yukawa
	do i = 1, OLP_N_MASSIVE_PARTICLES
	i_pdg = OLP_MASSIVE_PARTICLES(i)
	if (i_pdg < 0) cycle
	call flv%init (i_pdg, model)
	mass = flv%get_mass (); width = flv%get_width ()
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_mass_and_width (i_pdg, mass = mass, width = width)
	if (i_pdg == 5) call driver%blha_olp_set_parameter &
	('yuk(5)'//c_null_char, dble(mass), 0._double, ierr)
	if (i_pdg == 6) then
	if (driver%external_top_yukawa > 0._default) then
	top_yukawa = driver%external_top_yukawa
	else
	top_yukawa = mass
	end if
	call driver%blha_olp_set_parameter &
	('yuk(6)'//c_null_char, dble(top_yukawa), 0._double, ierr)
	end if
	if (driver%switch_off_muon_yukawas) then
	if (i_pdg == 13) call driver%blha_olp_set_parameter &
	('yuk(13)' //c_null_char, 0._double, 0._double, ierr)
	end if
	end select
	end do
	end subroutine prc_blha_set_particle_properties

	@ %def prc_blha_set_particle_properties
	@ This mask adapts which electroweak parameters are supposed to set according to
	the chosen BLHA EWScheme. This is only implemented for the default OLP method so far.
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: init_ew_parameters => prc_blha_init_ew_parameters
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_init_ew_parameters (object, ew_scheme)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in) :: ew_scheme
	end subroutine prc_blha_init_ew_parameters
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_init_ew_parameters (object, ew_scheme)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in) :: ew_scheme
	object%ew_parameter_mask = .false.
	select case (ew_scheme)
	case (BLHA_EW_0)
	object%ew_parameter_mask (I_ALPHA_0) = .true.
	case (BLHA_EW_GF)
	object%ew_parameter_mask (I_GF) = .true.
	case (BLHA_EW_MZ)
	object%ew_parameter_mask (I_ALPHA_MZ) = .true.
	case (BLHA_EW_INTERNAL)
	object%ew_parameter_mask (I_ALPHA_INTERNAL) = .true.
	end select
	end subroutine prc_blha_init_ew_parameters

	@ %def prc_blha_init_ew_parameters
	@ Computes a virtual matrix element from an interface to an
	external one-loop provider. The output of [[blha_olp_eval2]]
	is an array of [[dimension(4)]], corresponding to the
	$\epsilon^2$-, $\epsilon^1$- and $\epsilon^0$-poles of the
	virtual matrix element at position [[r(1:3)]] and the Born
	matrix element at position [[r(4)]]. The matrix element is
	rejected if its accuracy is larger than the maximal allowed
	accuracy. OpenLoops includes a factor of 1 / [[n_hel]] in the
	amplitudes, which we have to undo if polarized matrix elements
	are requested (GoSam does not support polarized matrix elements).
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: compute_sqme_virt => prc_blha_compute_sqme_virt
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_compute_sqme_virt (object, &
	i_flv, i_hel, p, ren_scale, es_scale, loop_method, sqme, bad_point)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale, es_scale
	integer, intent(in) :: loop_method
	real(default), dimension(4), intent(out) :: sqme
	logical, intent(out) :: bad_point
	end subroutine prc_blha_compute_sqme_virt
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_compute_sqme_virt (object, &
	i_flv, i_hel, p, ren_scale, es_scale, loop_method, sqme, bad_point)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in) :: ren_scale, es_scale
	integer, intent(in) :: loop_method
	real(default), dimension(4), intent(out) :: sqme
	logical, intent(out) :: bad_point
	real(double), dimension(5 * object%n_particles) :: mom
	real(double), dimension(:), allocatable :: r
	real(double) :: mu_dble, es_dble
	real(double) :: acc_dble
	real(default) :: acc
	real(default) :: alpha_s
	integer :: ierr
	if (object%i_virt(i_flv, i_hel) >= 0) then
	allocate (r (blha_result_array_size (object%n_particles, BLHA_AMP_LOOP)))
	if (debug_on) call msg_debug2 (D_VIRTUAL, "prc_blha_compute_sqme_virt")
	if (debug_on) call msg_debug2 (D_VIRTUAL, "i_flv", i_flv)
	if (debug_on) call msg_debug2 (D_VIRTUAL, "object%i_virt(i_flv, i_hel)", object%i_virt(i_flv, i_hel))
	if (debug2_active (D_VIRTUAL)) then
	call msg_debug2 (D_VIRTUAL, "use momenta: ")
	call vector4_write_set (p, show_mass = .true., &
	check_conservation = .true.)
	end if
	mom = object%create_momentum_array (p)
	if (vanishes (ren_scale)) &
	call msg_fatal ("prc_blha_compute_sqme_virt: ren_scale vanishes")
	mu_dble = dble (ren_scale)
	es_dble = dble (es_scale)
	alpha_s = object%qcd%alpha%get (ren_scale)
	select type (driver => object%driver)
	class is (blha_driver_t)
	if (loop_method == BLHA_MODE_OPENLOOPS) then
	call driver%blha_olp_set_parameter ('mureg'//c_null_char, es_dble, 0._double, ierr)
	if (ierr == 0) call parameter_error_message (var_str ('mureg'), &
	var_str ('prc_blha_compute_sqme_virt'))
	end if
	call driver%set_alpha_s (alpha_s)
	call driver%blha_olp_eval2 (object%i_virt(i_flv, i_hel), mom, mu_dble, r, acc_dble)
	end select
	acc = acc_dble
	sqme = r(1:4)
	bad_point = acc > object%maximum_accuracy
	if (object%includes_polarization ()) sqme = object%n_hel * sqme
	else
	sqme = zero
	end if
	end subroutine prc_blha_compute_sqme_virt

	@ %def prc_blha_compute_sqme_virt
	@ Computes a tree-level matrix element from an interface to an
	external one-loop provider. The matrix element is
	rejected if its accuracy is larger than the maximal allowed
	accuracy. OpenLoops includes a factor of 1 / [[n_hel]] in the
	amplitudes, which we have to undo if polarized matrix elements
	are requested (GoSam does not support polarized matrix elements).
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: compute_sqme => prc_blha_compute_sqme
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_compute_sqme (object, i_flv, i_hel, p, &
	ren_scale, sqme, bad_point)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out) :: sqme
	logical, intent(out) :: bad_point
	end subroutine prc_blha_compute_sqme
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_compute_sqme (object, i_flv, i_hel, p, &
	ren_scale, sqme, bad_point)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out) :: sqme
	logical, intent(out) :: bad_point
	real(double), dimension(5*object%n_particles) :: mom
	real(double), dimension(OLP_RESULTS_LIMIT) :: r
	real(double) :: mu_dble, acc_dble
	real(default) :: acc, alpha_s
	if (object%i_tree(i_flv, i_hel) >= 0) then
	if (debug_on) call msg_debug2 (D_REAL, "prc_blha_compute_sqme")
	if (debug_on) call msg_debug2 (D_REAL, "i_flv", i_flv)
	if (debug2_active (D_REAL)) then
	call msg_debug2 (D_REAL, "use momenta: ")
	call vector4_write_set (p, show_mass = .true., &
	check_conservation = .true.)
	end if
	mom = object%create_momentum_array (p)
	if (vanishes (ren_scale)) &
	call msg_fatal ("prc_blha_compute_sqme: ren_scale vanishes")
	mu_dble = dble(ren_scale)
	alpha_s = object%qcd%alpha%get (ren_scale)
	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_alpha_s (alpha_s)
	call driver%blha_olp_eval2 (object%i_tree(i_flv, i_hel), mom, &
	mu_dble, r, acc_dble)
	sqme = r(object%sqme_tree_pos)
	end select
	acc = acc_dble
	bad_point = acc > object%maximum_accuracy
	if (object%includes_polarization ()) sqme = object%n_hel * sqme
	else
	sqme = zero
	end if
	end subroutine prc_blha_compute_sqme

	@ %def prc_blha_compute_sqme
	@
	For the color correlated matrix the standard is to compute the diagonal entries
	from the born amplitudes and corresponding casimirs. However, if EW
	corrections are activated, the thus derived entries can be computed with born
	amplitudes of wrong coupling powers if the flavor structure potentially induces
	QCD-EW interference amplitudes. For this purpose a second possibility, to
	compute the diagonal from the off-diagonal elements is implemented as a special
	case.
	<<BLHA OLP interfaces: public>>=
	public :: blha_color_c_fill_diag
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_color_c_fill_diag &
	(sqme_born, flavors, sqme_color_c, special_case)
	real(default), intent(in) :: sqme_born
	integer, intent(in), dimension(:) :: flavors
	logical, intent(in), optional :: special_case
	real(default), intent(inout), dimension(:,:) :: sqme_color_c
	end subroutine blha_color_c_fill_diag
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_color_c_fill_diag &
	(sqme_born, flavors, sqme_color_c, special_case)
	real(default), intent(in) :: sqme_born
	integer, intent(in), dimension(:) :: flavors
	logical, intent(in), optional :: special_case
	real(default), intent(inout), dimension(:,:) :: sqme_color_c
	real(default) :: sqme_line_off
	integer :: i, j
	logical :: special_c
	special_c = .false.
	if (present (special_case)) &
	special_c = special_case .and. qcd_ew_interferences (flavors)
	do i = 1, size (flavors)
	if (is_quark (flavors(i))) then
	sqme_line_off = zero
	do j = 1, size (flavors)
	if (j /= i) sqme_line_off = sqme_line_off + sqme_color_c (i, j)
	end do
	if (special_c) then
	sqme_color_c (i, i) = - sqme_line_off
	else
	sqme_color_c (i, i) = -cf * sqme_born
	end if
	else if (is_gluon (flavors(i))) then
	sqme_line_off = zero
	do j = 1, size (flavors)
	if (j /= i) sqme_line_off = sqme_line_off + sqme_color_c (i, j)
	end do
	if (special_c) then
	sqme_color_c (i, i) = - sqme_line_off
	else
	sqme_color_c (i, i) = -ca * sqme_born
	end if
	else
	sqme_color_c (i, i) = zero
	end if
	end do
	end subroutine blha_color_c_fill_diag

	@ %def blha_color_c_fill_diag
	<<BLHA OLP interfaces: public>>=
	public :: blha_color_c_fill_offdiag
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine blha_color_c_fill_offdiag &
	(n, r, sqme_color_c, offset, n_flv)
	integer, intent(in) :: n
	real(default), intent(in), dimension(:) :: r
	real(default), intent(inout), dimension(:,:) :: sqme_color_c
	integer, intent(in), optional :: offset, n_flv
	end subroutine blha_color_c_fill_offdiag
	<<BLHA OLP interfaces: procedures>>=
	module subroutine blha_color_c_fill_offdiag &
	(n, r, sqme_color_c, offset, n_flv)
	integer, intent(in) :: n
	real(default), intent(in), dimension(:) :: r
	real(default), intent(inout), dimension(:,:) :: sqme_color_c
	integer, intent(in), optional :: offset, n_flv
	integer :: i, j, pos, incr
	if (present (offset)) then
	incr = offset
	else
	incr = 0
	end if
	pos = 0
	do j = 1, n
	do i = 1, j
	if (i /= j) then
	pos = (j - 1) * (j - 2) / 2 + i
	if (present (n_flv)) incr = incr + n_flv - 1
	if (present (offset)) pos = pos + incr
	sqme_color_c (i, j) = -r (pos)
	sqme_color_c (j, i) = sqme_color_c (i, j)
	end if
	end do
	end do
	end subroutine blha_color_c_fill_offdiag

	@ %def blha_color_c_fill_offdiag
	@ Computes a color-correlated matrix element from an interface to an
	external one-loop provider. The output of [[blha_olp_eval2]] is
	an array of [[dimension(n * (n - 1) / 2)]]. The matrix element is
	rejected if its accuracy is larger than the maximal allowed
	accuracy. OpenLoops includes a factor of 1 / [[n_hel]] in the
	amplitudes, which we have to undo if polarized matrix elements
	are requested (GoSam does not support polarized matrix elements).
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: compute_sqme_color_c_raw => prc_blha_compute_sqme_color_c_raw
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_compute_sqme_color_c_raw &
	(object, i_flv, i_hel, p, ren_scale, rr, bad_point)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out), dimension(:) :: rr
	logical, intent(out) :: bad_point
	end subroutine prc_blha_compute_sqme_color_c_raw
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_compute_sqme_color_c_raw &
	(object, i_flv, i_hel, p, ren_scale, rr, bad_point)
	class(prc_blha_t), intent(in) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out), dimension(:) :: rr
	logical, intent(out) :: bad_point
	real(double), dimension(5 * object%n_particles) :: mom
	real(double), dimension(size(rr)) :: r
	real(default) :: alpha_s, acc
	real(double) :: mu_dble, acc_dble
	if (debug2_active (D_REAL)) then
	call msg_debug2 (D_REAL, "use momenta: ")
	call vector4_write_set (p, show_mass = .true., &
	check_conservation = .true.)
	end if
	if (object%i_color_c(i_flv, i_hel) >= 0) then
	mom = object%create_momentum_array (p)
	if (vanishes (ren_scale)) &
	call msg_fatal ("prc_blha_compute_sqme_color_c: ren_scale vanishes")
	mu_dble = dble(ren_scale)
	alpha_s = object%qcd%alpha%get (ren_scale)

	select type (driver => object%driver)
	class is (blha_driver_t)
	call driver%set_alpha_s (alpha_s)
	call driver%blha_olp_eval2 (object%i_color_c(i_flv, i_hel), &
	mom, mu_dble, r, acc_dble)
	end select
	rr = r
	acc = acc_dble
	bad_point = acc > object%maximum_accuracy
	if (object%includes_polarization ()) rr = object%n_hel * rr
	else
	rr = zero
	end if
	end subroutine prc_blha_compute_sqme_color_c_raw

	@ %def prc_blha_compute_sqme_color_c_raw
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: compute_sqme_color_c => prc_blha_compute_sqme_color_c
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_compute_sqme_color_c &
	(object, i_flv, i_hel, p, ren_scale, born_color_c, bad_point, born_out)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(inout), dimension(:,:) :: born_color_c
	real(default), intent(out), optional :: born_out
	logical, intent(out) :: bad_point
	end subroutine prc_blha_compute_sqme_color_c
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_compute_sqme_color_c &
	(object, i_flv, i_hel, p, ren_scale, born_color_c, bad_point, born_out)
	class(prc_blha_t), intent(inout) :: object
	integer, intent(in) :: i_flv, i_hel
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(inout), dimension(:,:) :: born_color_c
	real(default), intent(out), optional :: born_out
	logical, intent(out) :: bad_point
	real(default), dimension(:), allocatable :: r
	logical :: bad_point2
	real(default) :: born
	integer, dimension(:), allocatable :: flavors
	if (debug2_active (D_REAL)) then
	call msg_debug2 (D_REAL, "use momenta: ")
	call vector4_write_set (p, show_mass = .true., &
	check_conservation = .true.)
	end if
	allocate (r (blha_result_array_size &
	(size(born_color_c, dim=1), BLHA_AMP_COLOR_C)))
	call object%compute_sqme_color_c_raw (i_flv, i_hel, p, ren_scale, r, bad_point)

	select type (driver => object%driver)
	class is (blha_driver_t)
	if (allocated (object%i_tree)) then
	call object%compute_sqme (i_flv, i_hel, p, ren_scale, born, bad_point2)
	else
	born = zero
	end if
	if (present (born_out)) born_out = born
	end select
	call blha_color_c_fill_offdiag (object%n_particles, r, born_color_c)
	flavors = object%get_flv_state (i_flv)
	call blha_color_c_fill_diag (born, flavors, born_color_c)

	bad_point = bad_point .or. bad_point2
	end subroutine prc_blha_compute_sqme_color_c

	@ %def prc_blha_compute_sqme_color_c
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	generic :: get_beam_helicities => get_beam_helicities_single
	generic :: get_beam_helicities => get_beam_helicities_array
	procedure :: get_beam_helicities_single => prc_blha_get_beam_helicities_single
	procedure :: get_beam_helicities_array => prc_blha_get_beam_helicities_array
	<<BLHA OLP interfaces: sub interfaces>>=
	module function prc_blha_get_beam_helicities_single &
	(object, i, invert_second) result (hel)
	integer, dimension(:), allocatable :: hel
	class(prc_blha_t), intent(in) :: object
	logical, intent(in), optional :: invert_second
	integer, intent(in) :: i
	end function prc_blha_get_beam_helicities_single
	module function prc_blha_get_beam_helicities_array &
	(object, invert_second) result (hel)
	integer, dimension(:,:), allocatable :: hel
	class(prc_blha_t), intent(in) :: object
	logical, intent(in), optional :: invert_second
	end function prc_blha_get_beam_helicities_array
	<<BLHA OLP interfaces: procedures>>=
	module function prc_blha_get_beam_helicities_single &
	(object, i, invert_second) result (hel)
	integer, dimension(:), allocatable :: hel
	class(prc_blha_t), intent(in) :: object
	logical, intent(in), optional :: invert_second
	integer, intent(in) :: i
	logical :: inv
	inv = .false.; if (present (invert_second)) inv = invert_second
	allocate (hel (object%data%n_in))
	hel = object%i_hel (i, :)
	if (inv .and. object%data%n_in == 2) hel(2) = -hel(2)
	end function prc_blha_get_beam_helicities_single

	@ %def prc_blha_get_beam_helicities_single
	@
	<<BLHA OLP interfaces: procedures>>=
	module function prc_blha_get_beam_helicities_array &
	(object, invert_second) result (hel)
	integer, dimension(:,:), allocatable :: hel
	class(prc_blha_t), intent(in) :: object
	logical, intent(in), optional :: invert_second
	integer :: i
	allocate (hel (object%n_proc, object%data%n_in))
	do i = 1, object%n_proc
	hel(i,:) = object%get_beam_helicities (i, invert_second)
	end do
	end function prc_blha_get_beam_helicities_array

	@ %def prc_blha_get_beam_helicities_array
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: includes_polarization => prc_blha_includes_polarization
	<<BLHA OLP interfaces: sub interfaces>>=
	module function prc_blha_includes_polarization (object) result (polarized)
	logical :: polarized
	class(prc_blha_t), intent(in) :: object
	end function prc_blha_includes_polarization
	<<BLHA OLP interfaces: procedures>>=
	module function prc_blha_includes_polarization (object) result (polarized)
	logical :: polarized
	class(prc_blha_t), intent(in) :: object
	select type (driver => object%driver)
	class is (blha_driver_t)
	polarized = driver%include_polarizations
	end select
	end function prc_blha_includes_polarization

	@ %def prc_blha_includes_polarization
	@ Setup an index mapping for flavor structures and helicities that give the same matrix
	element. The index mapping is according to the order of flavor structures known to the
	[[prc_core]] class. Overrides [[prc_core_set_equivalent_flv_hel_indices]].
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure :: set_equivalent_flv_hel_indices => prc_blha_set_equivalent_flv_hel_indices
	<<BLHA OLP interfaces: sub interfaces>>=
	module subroutine prc_blha_set_equivalent_flv_hel_indices (object)
	class(prc_blha_t), intent(inout) :: object
	end subroutine prc_blha_set_equivalent_flv_hel_indices
	<<BLHA OLP interfaces: procedures>>=
	module subroutine prc_blha_set_equivalent_flv_hel_indices (object)
	class(prc_blha_t), intent(inout) :: object
	integer :: n_flv, n_hel
	integer :: i_flv1, i_flv2, i_hel1, i_hel2
	integer, dimension(:,:), allocatable :: amp_id, amp_id_color
	if (allocated (object%i_virt)) then
	amp_id = object%i_virt
	else
	amp_id = object%i_tree
	end if
	if (allocated (object%i_color_c)) then
	amp_id_color = object%i_color_c
	end if
	n_flv = size (amp_id, dim=1)
	n_hel = size (amp_id, dim=2)
	if (.not. allocated (object%data%eqv_flv_index)) &
	allocate (object%data%eqv_flv_index(n_flv))
	if (.not. allocated (object%data%eqv_hel_index)) &
	allocate (object%data%eqv_hel_index(n_hel))
	if (size (object%data%eqv_flv_index) /= n_flv) &
	call msg_bug ("BLHA Core: Size mismatch between eqv_flv_index and number of flavors.")
	if (size (object%data%eqv_hel_index) /= n_hel) &
	call msg_bug ("BLHA Core: Size mismatch between eqv_hel_index and number of helicities.")
	do i_flv1 = 1, n_flv
	do i_hel1 = 1, n_hel
	FLV_LOOP: do i_flv2 = 1, i_flv1
	do i_hel2 = 1, i_hel1
	if (amp_id(i_flv2, i_hel2) == amp_id(i_flv1, i_hel1)) then
	if (.not. allocated (amp_id_color)) then
	object%data%eqv_flv_index(i_flv1) = i_flv2
	object%data%eqv_hel_index(i_hel1) = i_hel2
	exit FLV_LOOP
	else if (amp_id_color (i_flv2, i_hel2) == &
	amp_id_color(i_flv1, i_hel1)) then
	object%data%eqv_flv_index(i_flv1) = i_flv2
	object%data%eqv_hel_index(i_hel1) = i_hel2
	exit FLV_LOOP
	end if
	end if
	end do
	end do FLV_LOOP
	end do
	end do
	end subroutine prc_blha_set_equivalent_flv_hel_indices

	@ %def prc_blha_set_equivalent_flv_hel_indices
	@
	<<BLHA OLP interfaces: prc blha: TBP>>=
	procedure(prc_blha_init_driver), deferred :: &
	init_driver
	<<BLHA OLP interfaces: interfaces>>=
	abstract interface
	subroutine prc_blha_init_driver (object, os_data)
	import
	class(prc_blha_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	end subroutine prc_blha_init_driver
	end interface

	@ %def prc_blha_init_driver interface
	@ In general, the BLHA consists of a virtual matrix element and $n_{\rm{sub}}$
	subtraction terms. The subtractions terms can be pure Born matrix elements
	(to be used in collinear subtraction or in internal color-correlation),
	color-correlated matrix elements or spin-correlated matrix elements.
	The numbers should be ordered in such a way that $\mathcal{V}_{\rm{fin}}$
	is first, followed by the pure Born, the color-correlated and the spin-correlated
	matrix elements. This repeats $n_{\rm{flv}}$ times. Let $\nu_i$ be the position
	of the $i$th virtual matrix element. The next $\mathcal{V}_{\rm{fin}}$ is
	at position $\nu_i = \nu_{i - 1} + n_{\rm{sub}} + 1$. Obviously, $\nu_1 = 1$.
	This allows us to determine the virtual matrix element positions using the
	recursive function implemented below.
	<<BLHA OLP interfaces: public>>=
	public :: blha_loop_positions
	<<BLHA OLP interfaces: sub interfaces>>=
	recursive module function blha_loop_positions (i_flv, n_sub) result (index)
	integer :: index
	integer, intent(in) :: i_flv, n_sub
	end function blha_loop_positions
	<<BLHA OLP interfaces: procedures>>=
	recursive module function blha_loop_positions (i_flv, n_sub) result (index)
	integer :: index
	integer, intent(in) :: i_flv, n_sub
	index = 0
	if (i_flv == 1) then
	index = 1
	else
	index = blha_loop_positions (i_flv - 1, n_sub) + n_sub + 1
	end if
	end function blha_loop_positions

	@ %def blha_loop_positions
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[blha_ut.f90]]>>=
	<<File header>>

	module blha_ut
	use unit_tests
	use blha_uti

	<<Standard module head>>

	<<BLHA: public tests>>

	contains

	<<BLHA: test driver>>

	end module blha_ut

	@ %def blha_ut
	@
	<<[[blha_uti.f90]]>>=
	<<File header>>

	module blha_uti

	<<Use strings>>
	use format_utils, only: write_separator
	use variables, only: var_list_t
	use os_interface
	use models
	use blha_config


	<<Standard module head>>

	<<BLHA: test declarations>>

	contains

	<<BLHA: test procedures>>

	<<BLHA: tests>>

	end module blha_uti

	@ %def blha_uti
	@ API: driver for the unit tests below.
	<<BLHA: public tests>>=
	public :: blha_test
	<<BLHA: test driver>>=
	subroutine blha_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	call test(blha_1, "blha_1", "Test the creation of BLHA-OLP files", u, results)
	call test(blha_2, "blha_2", "Test the creation of BLHA-OLP files for "&
	&"multiple flavor structures", u, results)
	call test(blha_3, "blha_3", "Test helicity-information in OpenLoops OLP files", &
	u, results)
	end subroutine blha_test

	@ %def blha_test
	@
	<<BLHA: test procedures>>=
	subroutine setup_and_write_blha_configuration (u, single, polarized)
	integer, intent(in) :: u
	logical, intent(in), optional :: single
	logical, intent(in), optional :: polarized
	logical :: polrzd, singl
	type(blha_master_t) :: blha_master
	integer :: i
	integer :: n_in, n_out
	integer :: alpha_power, alphas_power
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	type(string_t) :: proc_id, method, correction_type
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(var_list_t) :: var_list
	type(model_t), pointer :: model => null ()
	integer :: openloops_phs_tolerance

	polrzd = .false.; if (present (polarized)) polrzd = polarized
	singl = .true.; if (present (single)) singl = single

	if (singl) then
	write (u, "(A)") "* Process: e+ e- -> W+ W- b b~"
	n_in = 2; n_out = 4
	alpha_power = 4; alphas_power = 0
	allocate (flv_born (n_in + n_out, 1))
	allocate (flv_real (n_in + n_out + 1, 1))
	flv_born(1,1) = 11; flv_born(2,1) = -11
	flv_born(3,1) = 24; flv_born(4,1) = -24
	flv_born(5,1) = 5; flv_born(6,1) = -5
	flv_real(1:6,1) = flv_born(:,1)
	flv_real(7,1) = 21
	else
	write (u, "(A)") "* Process: e+ e- -> u:d:s U:D:S"
	n_in = 2; n_out = 2
	alpha_power = 2; alphas_power = 0
	allocate (flv_born (n_in + n_out, 3))
	allocate (flv_real (n_in + n_out + 1, 3))
	flv_born(1,:) = 11; flv_born(2,:) = -11
	flv_born(3,1) = 1; flv_born(4,1) = -1
	flv_born(3,2) = 2; flv_born(4,2) = -2
	flv_born(3,3) = 3; flv_born(4,3) = -3
	flv_real(1:4,:) = flv_born
	flv_real(5,:) = 21
	end if
	proc_id = var_str ("BLHA_Test")

	call syntax_model_file_init ()
	call os_data%init ()
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), os_data, model)

	write (u, "(A)") "* BLHA matrix elements assumed for all process components"
	write (u, "(A)") "* Mode: GoSam"

	method = var_str ("gosam")
	correction_type = var_str ("QCD")
	call var_list%append_string (var_str ("$born_me_method"), method)
	call var_list%append_string (var_str ("$real_tree_me_method"), method)
	call var_list%append_string (var_str ("$loop_me_method"), method)
	call var_list%append_string (var_str ("$correlation_me_method"), method)
	call blha_master%set_ew_scheme (var_str ("GF"))
	call blha_master%set_methods (.true., var_list)
	call blha_master%allocate_config_files ()
	call blha_master%set_correction_type (correction_type)
	call blha_master%generate (proc_id, model, n_in, &
	alpha_power, alphas_power, flv_born, flv_real)

	call test_output (u)

	call blha_master%final ()
	call var_list%final ()
	write (u, "(A)") "* Switch to OpenLoops"
	openloops_phs_tolerance = 7

	method = var_str ("openloops")
	correction_type = var_str ("QCD")
	call var_list%append_string (var_str ("$born_me_method"), method)
	call var_list%append_string (var_str ("$real_tree_me_method"), method)
	call var_list%append_string (var_str ("$loop_me_method"), method)
	call var_list%append_string (var_str ("$correlation_me_method"), method)
	call blha_master%set_methods (.true., var_list)
	call blha_master%allocate_config_files ()
	call blha_master%set_correction_type (correction_type)
	call blha_master%generate (proc_id, model, n_in, &
	alpha_power, alphas_power, flv_born, flv_real)

	if (polrzd) then
	do i = 1, 4
	call blha_master%set_polarization (i)
	end do
	end if
	call blha_master%setup_additional_features &
	(openloops_phs_tolerance, .false., 0)

	call test_output (u)

	contains

	subroutine test_output (u)
	integer, intent(in) :: u
	do i = 1, 4
	call write_separator (u)
	call write_component_type (i, u)
	call write_separator (u)
	call blha_configuration_write &
	(blha_master%blha_cfg(i), blha_master%suffix(i), u, no_version = .true.)
	end do
	end subroutine test_output

	subroutine write_component_type (i, u)
	integer, intent(in) :: i, u
	type(string_t) :: message, component_type
	message = var_str ("OLP-File content for ")
	select case (i)
	case (1)
	component_type = var_str ("loop")
	case (2)
	component_type = var_str ("subtraction")
	case (3)
	component_type = var_str ("real")
	case (4)
	component_type = var_str ("born")
	end select
	message = message // component_type // " matrix elements"
	write (u, "(A)") char (message)
	end subroutine write_component_type

	end subroutine setup_and_write_blha_configuration

	@ %def setup_and_write_blha_configuration
	@
	<<BLHA: test declarations>>=
	public :: blha_1
	<<BLHA: tests>>=
	subroutine blha_1 (u)
	integer, intent(in) :: u
	write (u, "(A)") "* Test output: blha_1"
	write (u, "(A)") "* Purpose: Test the creation of olp-files for single "&
	&"and unpolarized flavor structures"
	write (u, "(A)")
	call setup_and_write_blha_configuration (u, single = .true., polarized = .false.)
	end subroutine blha_1

	@ %def blha_1
	@
	<<BLHA: test declarations>>=
	public :: blha_2
	<<BLHA: tests>>=
	subroutine blha_2 (u)
	integer, intent(in) :: u
	write (u, "(A)") "* Test output: blha_2"
	write (u, "(A)") "* Purpose: Test the creation of olp-files for multiple "&
	&"and unpolarized flavor structures"
	write (u, "(A)")
	call setup_and_write_blha_configuration (u, single = .false., polarized = .false.)
	end subroutine blha_2

	@ %def blha_2
	@
	<<BLHA: test declarations>>=
	public :: blha_3
	<<BLHA: tests>>=
	subroutine blha_3 (u)
	integer, intent(in) :: u
	write (u, "(A)") "* Test output: blha_3"
	write (u, "(A)") "* Purpose: Test the creation of olp-files for single "&
	&"and polarized flavor structures"
	write (u, "(A)")
	call setup_and_write_blha_configuration (u, single = .true., polarized = .true.)
	end subroutine blha_3

	@ %def blha_3
	@
	Index: trunk/src/openloops/openloops.nw
	===================================================================
	--- trunk/src/openloops/openloops.nw (revision 8903)
	+++ trunk/src/openloops/openloops.nw (revision 8904)
	@@ -1,927 +1,946 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: interface to OpenLoops 1-loop library
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{OpenLoops Interface}
	\includemodulegraph{openloops}

	The interface to OpenLoops.

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	<<[[prc_openloops.f90]]>>=
	<<File header>>

	module prc_openloops

	use, intrinsic :: iso_c_binding !NODEP!

	use kinds
	<<Use strings>>
	use string_utils, only: str
	use physics_defs
	use variables
	use os_interface
	use lorentz
	use interactions
	use model_data
	use prc_core_def
	use prc_core

	use blha_config
	use blha_olp_interfaces

	<<Use mpi f08>>

	<<Standard module head>>

	<<Prc openloops: public>>

	<<Prc openloops: main parameters>>

	<<Prc openloops: types>>

	<<Prc openloops: interfaces>>

	interface
	<<Prc openloops: sub interfaces>>
	end interface

	contains

	<<Prc openloops: main procedures>>

	end module prc_openloops
	@ %def module prc_openloops
	@
	<<[[prc_openloops_sub.f90]]>>=
	<<File header>>

	submodule (prc_openloops) prc_openloops_s

	<<Use debug>>
	use io_units
	use constants
	use numeric_utils
	use diagnostics
	use system_dependencies
	use sm_physics, only: top_width_sm_lo, top_width_sm_qcd_nlo_jk
	use sm_qcd
	use prclib_interfaces

	implicit none

	<<Prc openloops: parameters>>

	contains

	<<Prc openloops: procedures>>

	end submodule prc_openloops_s

	@ %def prc_openloops_s
	@
	<<Prc openloops: parameters>>=
	real(default), parameter :: openloops_default_bmass = 0._default
	real(default), parameter :: openloops_default_topmass = 172._default
	real(default), parameter :: openloops_default_topwidth = 0._default
	real(default), parameter :: openloops_default_wmass = 80.399_default
	real(default), parameter :: openloops_default_wwidth = 0._default
	real(default), parameter :: openloops_default_zmass = 91.1876_default
	real(default), parameter :: openloops_default_zwidth = 0._default
	real(default), parameter :: openloops_default_higgsmass = 125._default
	real(default), parameter :: openloops_default_higgswidth = 0._default

	<<Prc openloops: main parameters>>=
	integer :: N_EXTERNAL = 0

	@ %def openloops default parameter
	@
	<<Prc openloops: interfaces>>=
	abstract interface
	subroutine ol_evaluate_scpowheg (id, pp, emitter, res, resmunu) bind(C)
	import
	integer(kind = c_int), value :: id, emitter
	real(kind = c_double), intent(in) :: pp(5 * N_EXTERNAL)
	real(kind = c_double), intent(out) :: res, resmunu(16)
	end subroutine ol_evaluate_scpowheg
	end interface

	@ %def ol_evaluate_scpowheg interface
	@
	<<Prc openloops: interfaces>>=
	abstract interface
	subroutine ol_getparameter_double (variable_name, value) bind(C)
	import
	character(kind = c_char,len = 1), intent(in) :: variable_name
	real(kind = c_double), intent(out) :: value
	end subroutine ol_getparameter_double
	end interface

	@ %def ol_getparameter_double interface
	@
	<<Prc openloops: types>>=
	type, extends (prc_blha_writer_t) :: openloops_writer_t
	contains
	<<Prc openloops: openloops writer: TBP>>
	end type openloops_writer_t

	@ %def openloops_writer_t
	@
	<<Prc openloops: public>>=
	public :: openloops_def_t
	<<Prc openloops: types>>=
	type, extends (blha_def_t) :: openloops_def_t
	integer :: verbosity
	contains
	<<Prc openloops: openloops def: TBP>>
	end type openloops_def_t

	@ %def openloops_def_t
	@
	<<Prc openloops: types>>=
	type, extends (blha_driver_t) :: openloops_driver_t
	integer :: n_external = 0
	type(string_t) :: olp_file
	procedure(ol_evaluate_scpowheg), nopass, pointer :: &
	evaluate_spin_correlations_powheg => null ()
	procedure(ol_getparameter_double), nopass, pointer :: &
	get_parameter_double => null ()
	contains
	<<Prc openloops: openloops driver: TBP>>
	end type openloops_driver_t

	@ %def openloops_driver_t
	@
	<<Prc openloops: types>>=
	type :: openloops_threshold_data_t
	logical :: nlo = .true.
	real(default) :: alpha_ew
	real(default) :: sinthw
	real(default) :: m_b, m_W
	real(default) :: vtb
	contains
	<<Prc openloops: openloops threshold data: TBP>>
	end type openloops_threshold_data_t

	@ %def openloops_threshold_data_t
	@
	<<Prc openloops: openloops threshold data: TBP>>=
	procedure :: compute_top_width => &
	openloops_threshold_data_compute_top_width
	<<Prc openloops: sub interfaces>>=
	module function openloops_threshold_data_compute_top_width &
	(data, mtop, alpha_s) result (wtop)
	real(default) :: wtop
	class(openloops_threshold_data_t), intent(in) :: data
	real(default), intent(in) :: mtop, alpha_s
	end function openloops_threshold_data_compute_top_width
	<<Prc openloops: procedures>>=
	module function openloops_threshold_data_compute_top_width &
	(data, mtop, alpha_s) result (wtop)
	real(default) :: wtop
	class(openloops_threshold_data_t), intent(in) :: data
	real(default), intent(in) :: mtop, alpha_s
	if (data%nlo) then
	wtop = top_width_sm_qcd_nlo_jk (data%alpha_ew, data%sinthw, &
	data%vtb, mtop, data%m_W, data%m_b, alpha_s)
	else
	wtop = top_width_sm_lo (data%alpha_ew, data%sinthw, data%vtb, &
	mtop, data%m_W, data%m_b)
	end if
	end function openloops_threshold_data_compute_top_width

	@ %def openloops_threshold_data_compute_top_width
	@
	<<Prc openloops: public>>=
	public :: openloops_state_t
	<<Prc openloops: types>>=
	type, extends (blha_state_t) :: openloops_state_t
	type(openloops_threshold_data_t), allocatable :: threshold_data
	contains
	<<Prc openloops: openloops state: TBP>>
	end type openloops_state_t

	@ %def openloops_state_t
	@
	<<Prc openloops: openloops state: TBP>>=
	procedure :: init_threshold => openloops_state_init_threshold
	<<Prc openloops: sub interfaces>>=
	module subroutine openloops_state_init_threshold (object, model)
	class(openloops_state_t), intent(inout) :: object
	type(model_data_t), intent(in) :: model
	end subroutine openloops_state_init_threshold
	<<Prc openloops: procedures>>=
	module subroutine openloops_state_init_threshold (object, model)
	class(openloops_state_t), intent(inout) :: object
	type(model_data_t), intent(in) :: model
	if (model%get_name () == "SM_tt_threshold") then
	allocate (object%threshold_data)
	associate (data => object%threshold_data)
	data%nlo = btest (int (model%get_real (var_str ('offshell_strategy'))), 0)
	data%alpha_ew = one / model%get_real (var_str ('alpha_em_i'))
	data%sinthw = model%get_real (var_str ('sw'))
	data%m_b = model%get_real (var_str ('mb'))
	data%m_W = model%get_real (var_str ('mW'))
	data%vtb = model%get_real (var_str ('Vtb'))
	end associate
	end if
	end subroutine openloops_state_init_threshold

	@ %def openloops_state_init_threshold
	@
	<<Prc openloops: public>>=
	public :: prc_openloops_t
	<<Prc openloops: types>>=
	type, extends (prc_blha_t) :: prc_openloops_t
	contains
	<<Prc openloops: prc openloops: TBP>>
	end type prc_openloops_t

	@ %def prc_openloops_t
	@
	<<Prc openloops: openloops writer: TBP>>=
	procedure, nopass :: type_name => openloops_writer_type_name
	<<Prc openloops: sub interfaces>>=
	module function openloops_writer_type_name () result (string)
	type(string_t) :: string
	end function openloops_writer_type_name
	<<Prc openloops: procedures>>=
	module function openloops_writer_type_name () result (string)
	type(string_t) :: string
	string = "openloops"
	end function openloops_writer_type_name

	@ %def openloops_writer_type_name
	@ Gfortran 7/8/9 bug: has to remain in the main module.
	<<Prc openloops: openloops def: TBP>>=
	procedure :: init => openloops_def_init
	<<Prc openloops: main procedures>>=
	subroutine openloops_def_init (object, basename, model_name, &
	- prt_in, prt_out, nlo_type, restrictions, var_list)
	+ prt_in, prt_out, nlo_type, ufo, ufo_path, restrictions, var_list)
	class(openloops_def_t), intent(inout) :: object
	type(string_t), intent(in) :: basename, model_name
	type(string_t), dimension(:), intent(in) :: prt_in, prt_out
	integer, intent(in) :: nlo_type
	+ logical, intent(in), optional :: ufo
	+ type(string_t), intent(in), optional :: ufo_path
	type(string_t), intent(in), optional :: restrictions
	type(var_list_t), intent(in) :: var_list
	<<Prc openloops: openloops def init: variables>>
	object%basename = basename
	allocate (openloops_writer_t :: object%writer)
	select case (nlo_type)
	case (BORN)
	object%suffix = '_BORN'
	case (NLO_REAL)
	object%suffix = '_REAL'
	case (NLO_VIRTUAL)
	object%suffix = '_LOOP'
	case (NLO_SUBTRACTION, NLO_MISMATCH)
	object%suffix = '_SUB'
	case (NLO_DGLAP)
	object%suffix = '_DGLAP'
	end select
	<<Prc openloops: openloops def init: suffix>>
	select type (writer => object%writer)
	class is (prc_blha_writer_t)
	- call writer%init (model_name, prt_in, prt_out, restrictions)
	+ call writer%init (model_name, prt_in, prt_out, ufo, ufo_path, restrictions)
	end select
	object%verbosity = var_list%get_ival (var_str ("openloops_verbosity"))
	end subroutine openloops_def_init

	@ %def openloops_def_init
	@ Add additional suffix for each rank of the communicator, such that the
	filenames do not clash.
	<<MPI: Prc openloops: openloops def init: variables>>=
	integer :: n_size, rank
	<<MPI: Prc openloops: openloops def init: suffix>>=
	call MPI_comm_rank (MPI_COMM_WORLD, rank)
	call MPI_Comm_size (MPI_COMM_WORLD, n_size)
	if (n_size > 1) then
	object%suffix = object%suffix // var_str ("_") // str (rank)
	end if
	@
	<<Prc openloops: openloops def: TBP>>=
	procedure, nopass :: type_string => openloops_def_type_string
	<<Prc openloops: sub interfaces>>=
	module function openloops_def_type_string () result (string)
	type(string_t) :: string
	end function openloops_def_type_string
	<<Prc openloops: procedures>>=
	module function openloops_def_type_string () result (string)
	type(string_t) :: string
	string = "openloops"
	end function openloops_def_type_string

	@
	@ %def openloops_def_type_string
	<<Prc openloops: openloops def: TBP>>=
	procedure :: write => openloops_def_write
	<<Prc openloops: sub interfaces>>=
	module subroutine openloops_def_write (object, unit)
	class(openloops_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine openloops_def_write
	<<Prc openloops: procedures>>=
	module subroutine openloops_def_write (object, unit)
	class(openloops_def_t), intent(in) :: object
	integer, intent(in) :: unit
	select type (writer => object%writer)
	type is (openloops_writer_t)
	call writer%write (unit)
	end select
	end subroutine openloops_def_write

	@
	@ %def openloops_def_write
	<<Prc openloops: openloops driver: TBP>>=
	procedure :: init_dlaccess_to_library => &
	openloops_driver_init_dlaccess_to_library
	<<Prc openloops: sub interfaces>>=
	module subroutine openloops_driver_init_dlaccess_to_library &
	(object, os_data, dlaccess, success)
	class(openloops_driver_t), intent(in) :: object
	type(os_data_t), intent(in) :: os_data
	type(dlaccess_t), intent(out) :: dlaccess
	logical, intent(out) :: success
	end subroutine openloops_driver_init_dlaccess_to_library
	<<Prc openloops: procedures>>=
	module subroutine openloops_driver_init_dlaccess_to_library &
	(object, os_data, dlaccess, success)
	class(openloops_driver_t), intent(in) :: object
	type(os_data_t), intent(in) :: os_data
	type(dlaccess_t), intent(out) :: dlaccess
	logical, intent(out) :: success
	type(string_t) :: ol_library, msg_buffer
	ol_library = OPENLOOPS_DIR // '/lib/libopenloops.' // &
	os_data%shrlib_ext
	msg_buffer = "One-Loop-Provider: Using OpenLoops"
	call msg_message (char(msg_buffer))
	msg_buffer = "Loading library: " // ol_library
	call msg_message (char(msg_buffer))
	if (os_file_exist (ol_library)) then
	call dlaccess_init (dlaccess, var_str (""), ol_library, os_data)
	else
	call msg_fatal ("Link OpenLoops: library not found")
	end if
	success = .not. dlaccess_has_error (dlaccess)
	end subroutine openloops_driver_init_dlaccess_to_library

	@ %def openloops_driver_init_dlaccess_to_library
	@
	<<Prc openloops: openloops driver: TBP>>=
	procedure :: set_alpha_s => openloops_driver_set_alpha_s
	<<Prc openloops: sub interfaces>>=
	module subroutine openloops_driver_set_alpha_s (driver, alpha_s)
	class(openloops_driver_t), intent(in) :: driver
	real(default), intent(in) :: alpha_s
	end subroutine openloops_driver_set_alpha_s
	<<Prc openloops: procedures>>=
	module subroutine openloops_driver_set_alpha_s (driver, alpha_s)
	class(openloops_driver_t), intent(in) :: driver
	real(default), intent(in) :: alpha_s
	integer :: ierr
	if (associated (driver%blha_olp_set_parameter)) then
	call driver%blha_olp_set_parameter &
	(c_char_'alphas'//c_null_char, &
	dble (alpha_s), 0._double, ierr)
	else
	call msg_fatal ("blha_olp_set_parameter not associated!")
	end if
	if (ierr == 0) call parameter_error_message (var_str ('alphas'), &
	var_str ('openloops_driver_set_alpha_s'))
	end subroutine openloops_driver_set_alpha_s

	@ %def openloops_driver_set_alpha_s
	@
	<<Prc openloops: openloops driver: TBP>>=
	procedure :: set_alpha_qed => openloops_driver_set_alpha_qed
	<<Prc openloops: sub interfaces>>=
	module subroutine openloops_driver_set_alpha_qed (driver, alpha)
	class(openloops_driver_t), intent(inout) :: driver
	real(default), intent(in) :: alpha
	end subroutine openloops_driver_set_alpha_qed
	<<Prc openloops: procedures>>=
	module subroutine openloops_driver_set_alpha_qed (driver, alpha)
	class(openloops_driver_t), intent(inout) :: driver
	real(default), intent(in) :: alpha
	integer :: ierr
	call driver%blha_olp_set_parameter &
	(c_char_'alpha_qed'//c_null_char, &
	dble (alpha), 0._double, ierr)
	if (ierr == 0) call ew_parameter_error_message (var_str ('alpha_qed'))
	end subroutine openloops_driver_set_alpha_qed

	@ %def openloops_driver_set_alpha_qed
	@
	<<Prc openloops: openloops driver: TBP>>=
	procedure :: set_GF => openloops_driver_set_GF
	<<Prc openloops: sub interfaces>>=
	module subroutine openloops_driver_set_GF (driver, GF)
	class(openloops_driver_t), intent(inout) :: driver
	real(default), intent(in) :: GF
	end subroutine openloops_driver_set_GF
	<<Prc openloops: procedures>>=
	module subroutine openloops_driver_set_GF (driver, GF)
	class(openloops_driver_t), intent(inout) :: driver
	real(default), intent(in) :: GF
	integer :: ierr
	call driver%blha_olp_set_parameter &
	(c_char_'Gmu'//c_null_char, &
	dble(GF), 0._double, ierr)
	if (ierr == 0) call ew_parameter_error_message (var_str ('Gmu'))
	end subroutine openloops_driver_set_GF

	@ %def openloops_driver_set_GF
	@
	<<Prc openloops: openloops driver: TBP>>=
	procedure :: set_weinberg_angle => openloops_driver_set_weinberg_angle
	<<Prc openloops: sub interfaces>>=
	module subroutine openloops_driver_set_weinberg_angle (driver, sw2)
	class(openloops_driver_t), intent(inout) :: driver
	real(default), intent(in) :: sw2
	end subroutine openloops_driver_set_weinberg_angle
	<<Prc openloops: procedures>>=
	module subroutine openloops_driver_set_weinberg_angle (driver, sw2)
	class(openloops_driver_t), intent(inout) :: driver
	real(default), intent(in) :: sw2
	integer :: ierr
	call driver%blha_olp_set_parameter &
	(c_char_'sw2'//c_null_char, &
	dble(sw2), 0._double, ierr)
	if (ierr == 0) call ew_parameter_error_message (var_str ('sw2'))
	end subroutine openloops_driver_set_weinberg_angle

	@ %def openloops_driver_set_weinberg_angle
	@
	<<Prc openloops: openloops driver: TBP>>=
	+ procedure :: set_ufo_parameter => openloops_driver_set_ufo_parameter
	+<<Prc openloops: sub interfaces>>=
	+ module subroutine openloops_driver_set_ufo_parameter (driver, par_name, ufo_par)
	+ class(openloops_driver_t), intent(inout) :: driver
	+ type(string_t), intent(in) :: par_name
	+ real(default), intent(in) :: ufo_par
	+ end subroutine openloops_driver_set_ufo_parameter
	+<<Prc openloops: procedures>>=
	+ module subroutine openloops_driver_set_ufo_parameter (driver, par_name, ufo_par)
	+ class(openloops_driver_t), intent(inout) :: driver
	+ type(string_t), intent(in) :: par_name
	+ real(default), intent(in) :: ufo_par
	+ end subroutine openloops_driver_set_ufo_parameter
	+
	+@ %def openloops_driver_set_ufo_parameter
	+@
	+<<Prc openloops: openloops driver: TBP>>=
	procedure :: print_alpha_s => openloops_driver_print_alpha_s
	<<Prc openloops: sub interfaces>>=
	module subroutine openloops_driver_print_alpha_s (object)
	class(openloops_driver_t), intent(in) :: object
	end subroutine openloops_driver_print_alpha_s
	<<Prc openloops: procedures>>=
	module subroutine openloops_driver_print_alpha_s (object)
	class(openloops_driver_t), intent(in) :: object
	call object%blha_olp_print_parameter (c_char_'alphas'//c_null_char)
	end subroutine openloops_driver_print_alpha_s

	@ %def openloops_driver_print_alpha_s
	@
	<<Prc openloops: openloops driver: TBP>>=
	procedure, nopass :: type_name => openloops_driver_type_name
	<<Prc openloops: sub interfaces>>=
	module function openloops_driver_type_name () result (type)
	type(string_t) :: type
	end function openloops_driver_type_name
	<<Prc openloops: procedures>>=
	module function openloops_driver_type_name () result (type)
	type(string_t) :: type
	type = "OpenLoops"
	end function openloops_driver_type_name

	@ %def openloops_driver_type_name
	@
	<<Prc openloops: openloops driver: TBP>>=
	procedure :: load_procedures => openloops_driver_load_procedures
	<<Prc openloops: sub interfaces>>=
	module subroutine openloops_driver_load_procedures &
	(object, os_data, success)
	class(openloops_driver_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	logical, intent(out) :: success
	end subroutine openloops_driver_load_procedures
	<<Prc openloops: procedures>>=
	module subroutine openloops_driver_load_procedures &
	(object, os_data, success)
	class(openloops_driver_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	logical, intent(out) :: success
	type(dlaccess_t) :: dlaccess
	type(c_funptr) :: c_fptr
	logical :: init_success

	call object%init_dlaccess_to_library (os_data, dlaccess, init_success)

	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("ol_evaluate_scpowheg"))
	call c_f_procpointer (c_fptr, object%evaluate_spin_correlations_powheg)
	call check_for_error (var_str ("ol_evaluate_scpowheg"))
	c_fptr = dlaccess_get_c_funptr (dlaccess, var_str ("ol_getparameter_double"))
	call c_f_procpointer (c_fptr, object%get_parameter_double)
	call check_for_error (var_str ("ol_getparameter_double"))
	success = .true.

	contains
	subroutine check_for_error (function_name)
	type(string_t), intent(in) :: function_name
	if (dlaccess_has_error (dlaccess)) &
	call msg_fatal (char ("Loading of " // function_name // " failed!"))
	end subroutine check_for_error
	end subroutine openloops_driver_load_procedures

	@ %def openloops_driver_load_procedures
	@
	<<Prc openloops: openloops def: TBP>>=
	procedure :: read => openloops_def_read
	<<Prc openloops: sub interfaces>>=
	module subroutine openloops_def_read (object, unit)
	class(openloops_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine openloops_def_read
	<<Prc openloops: procedures>>=
	module subroutine openloops_def_read (object, unit)
	class(openloops_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine openloops_def_read

	@ %def openloops_def_read
	@ Gfortran 7/8/9 bug: has to remain in the main module.
	<<Prc openloops: openloops def: TBP>>=
	procedure :: allocate_driver => openloops_def_allocate_driver
	<<Prc openloops: main procedures>>=
	subroutine openloops_def_allocate_driver (object, driver, basename)
	class(openloops_def_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	if (.not. allocated (driver)) allocate (openloops_driver_t :: driver)
	end subroutine openloops_def_allocate_driver

	@
	@ %def openloops_def_allocate_driver
	<<Prc openloops: openloops state: TBP>>=
	procedure :: write => openloops_state_write
	<<Prc openloops: sub interfaces>>=
	module subroutine openloops_state_write (object, unit)
	class(openloops_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine openloops_state_write
	<<Prc openloops: procedures>>=
	module subroutine openloops_state_write (object, unit)
	class(openloops_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine openloops_state_write

	@ %def prc_openloops_state_write
	@ Gfortran 7/8/9 bug: has to remain in the main module.
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: allocate_workspace => prc_openloops_allocate_workspace
	<<Prc openloops: main procedures>>=
	subroutine prc_openloops_allocate_workspace (object, core_state)
	class(prc_openloops_t), intent(in) :: object
	class(prc_core_state_t), intent(inout), allocatable :: core_state
	allocate (openloops_state_t :: core_state)
	end subroutine prc_openloops_allocate_workspace

	@ %def prc_openloops_allocate_workspace
	@
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: init_driver => prc_openloops_init_driver
	<<Prc openloops: sub interfaces>>=
	module subroutine prc_openloops_init_driver (object, os_data)
	class(prc_openloops_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	end subroutine prc_openloops_init_driver
	<<Prc openloops: procedures>>=
	module subroutine prc_openloops_init_driver (object, os_data)
	class(prc_openloops_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	type(string_t) :: olp_file, olc_file
	type(string_t) :: suffix

	select type (def => object%def)
	type is (openloops_def_t)
	suffix = def%suffix
	olp_file = def%basename // suffix // '.olp'
	olc_file = def%basename // suffix // '.olc'
	class default
	call msg_bug ("prc_openloops_init_driver: core_def should be openloops-type")
	end select

	select type (driver => object%driver)
	type is (openloops_driver_t)
	driver%olp_file = olp_file
	driver%contract_file = olc_file
	driver%nlo_suffix = suffix
	end select
	end subroutine prc_openloops_init_driver

	@ %def prc_openloops_init_driver
	@
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: write => prc_openloops_write
	<<Prc openloops: sub interfaces>>=
	module subroutine prc_openloops_write (object, unit)
	class(prc_openloops_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_openloops_write
	<<Prc openloops: procedures>>=
	module subroutine prc_openloops_write (object, unit)
	class(prc_openloops_t), intent(in) :: object
	integer, intent(in), optional :: unit
	call msg_message (unit = unit, string = "OpenLoops")
	end subroutine prc_openloops_write

	@
	@ %def prc_openloops_write
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: write_name => prc_openloops_write_name
	<<Prc openloops: sub interfaces>>=
	module subroutine prc_openloops_write_name (object, unit)
	class(prc_openloops_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine prc_openloops_write_name
	<<Prc openloops: procedures>>=
	module subroutine prc_openloops_write_name (object, unit)
	class(prc_openloops_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u,"(1x,A)") "Core: OpenLoops"
	end subroutine prc_openloops_write_name

	@
	@ %def prc_openloops_write_name

	<<Prc openloops: prc openloops: TBP>>=
	procedure :: prepare_library => prc_openloops_prepare_library
	<<Prc openloops: sub interfaces>>=
	module subroutine prc_openloops_prepare_library (object, os_data, model)
	class(prc_openloops_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	type(model_data_t), intent(in), target :: model
	end subroutine prc_openloops_prepare_library
	<<Prc openloops: procedures>>=
	module subroutine prc_openloops_prepare_library (object, os_data, model)
	class(prc_openloops_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	type(model_data_t), intent(in), target :: model
	call object%load_driver (os_data)
	call object%reset_parameters ()
	call object%set_particle_properties (model)
	select type(def => object%def)
	type is (openloops_def_t)
	call object%set_verbosity (def%verbosity)
	end select
	end subroutine prc_openloops_prepare_library

	@ %def prc_openloops_prepare_library
	@
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: load_driver => prc_openloops_load_driver
	<<Prc openloops: sub interfaces>>=
	module subroutine prc_openloops_load_driver (object, os_data)
	class(prc_openloops_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	end subroutine prc_openloops_load_driver
	<<Prc openloops: procedures>>=
	module subroutine prc_openloops_load_driver (object, os_data)
	class(prc_openloops_t), intent(inout) :: object
	type(os_data_t), intent(in) :: os_data
	logical :: success
	select type (driver => object%driver)
	type is (openloops_driver_t)
	call driver%load (os_data, success)
	call driver%load_procedures (os_data, success)
	end select
	end subroutine prc_openloops_load_driver

	@ %def prc_openloops_load_driver
	@
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: start => prc_openloops_start
	<<Prc openloops: sub interfaces>>=
	module subroutine prc_openloops_start (object)
	class(prc_openloops_t), intent(inout) :: object
	end subroutine prc_openloops_start
	<<Prc openloops: procedures>>=
	module subroutine prc_openloops_start (object)
	class(prc_openloops_t), intent(inout) :: object
	integer :: ierr
	select type (driver => object%driver)
	type is (openloops_driver_t)
	call driver%blha_olp_start (char (driver%olp_file)//c_null_char, ierr)
	end select
	end subroutine prc_openloops_start

	@ %def prc_openloops_start
	@
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: set_n_external => prc_openloops_set_n_external
	<<Prc openloops: sub interfaces>>=
	module subroutine prc_openloops_set_n_external (object, n)
	class(prc_openloops_t), intent(inout) :: object
	integer, intent(in) :: n
	end subroutine prc_openloops_set_n_external
	<<Prc openloops: procedures>>=
	module subroutine prc_openloops_set_n_external (object, n)
	class(prc_openloops_t), intent(inout) :: object
	integer, intent(in) :: n
	N_EXTERNAL = n
	end subroutine prc_openloops_set_n_external

	@ %def prc_openloops_set_n_external
	@
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: reset_parameters => prc_openloops_reset_parameters
	<<Prc openloops: sub interfaces>>=
	module subroutine prc_openloops_reset_parameters (object)
	class(prc_openloops_t), intent(inout) :: object
	end subroutine prc_openloops_reset_parameters
	<<Prc openloops: procedures>>=
	module subroutine prc_openloops_reset_parameters (object)
	class(prc_openloops_t), intent(inout) :: object
	integer :: ierr
	select type (driver => object%driver)
	type is (openloops_driver_t)
	call driver%blha_olp_set_parameter ('mass(5)'//c_null_char, &
	dble(openloops_default_bmass), 0._double, ierr)
	call driver%blha_olp_set_parameter ('mass(6)'//c_null_char, &
	dble(openloops_default_topmass), 0._double, ierr)
	call driver%blha_olp_set_parameter ('width(6)'//c_null_char, &
	dble(openloops_default_topwidth), 0._double, ierr)
	call driver%blha_olp_set_parameter ('mass(23)'//c_null_char, &
	dble(openloops_default_zmass), 0._double, ierr)
	call driver%blha_olp_set_parameter ('width(23)'//c_null_char, &
	dble(openloops_default_zwidth), 0._double, ierr)
	call driver%blha_olp_set_parameter ('mass(24)'//c_null_char, &
	dble(openloops_default_wmass), 0._double, ierr)
	call driver%blha_olp_set_parameter ('width(24)'//c_null_char, &
	dble(openloops_default_wwidth), 0._double, ierr)
	call driver%blha_olp_set_parameter ('mass(25)'//c_null_char, &
	dble(openloops_default_higgsmass), 0._double, ierr)
	call driver%blha_olp_set_parameter ('width(25)'//c_null_char, &
	dble(openloops_default_higgswidth), 0._double, ierr)
	end select
	end subroutine prc_openloops_reset_parameters

	@ %def prc_openloops_reset_parameters
	@ Set the verbosity level for openloops. The different levels are as follows:
	\begin{itemize}
	\item[0] minimal output (startup message et.al.)
	\item[1] show which libraries are loaded
	\item[2] show debug information of the library loader, but not during run time
	\item[3] show debug information during run time
	\item[4] output for each call of [[set_parameters]].
	\end{itemize}
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: set_verbosity => prc_openloops_set_verbosity
	<<Prc openloops: sub interfaces>>=
	module subroutine prc_openloops_set_verbosity (object, verbose)
	class(prc_openloops_t), intent(inout) :: object
	integer, intent(in) :: verbose
	end subroutine prc_openloops_set_verbosity
	<<Prc openloops: procedures>>=
	module subroutine prc_openloops_set_verbosity (object, verbose)
	class(prc_openloops_t), intent(inout) :: object
	integer, intent(in) :: verbose
	integer :: ierr
	select type (driver => object%driver)
	type is (openloops_driver_t)
	call driver%blha_olp_set_parameter ('verbose'//c_null_char, &
	dble(verbose), 0._double, ierr)
	end select
	end subroutine prc_openloops_set_verbosity

	@ %def prc_openloops_set_verbosity
	@
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: prepare_external_code => &
	prc_openloops_prepare_external_code
	<<Prc openloops: sub interfaces>>=
	module subroutine prc_openloops_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_openloops_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	end subroutine prc_openloops_prepare_external_code
	<<Prc openloops: procedures>>=
	module subroutine prc_openloops_prepare_external_code &
	(core, flv_states, var_list, os_data, libname, model, i_core, is_nlo)
	class(prc_openloops_t), intent(inout) :: core
	integer, intent(in), dimension(:,:), allocatable :: flv_states
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in) :: libname
	type(model_data_t), intent(in), target :: model
	integer, intent(in) :: i_core
	logical, intent(in) :: is_nlo
	integer :: ierr
	core%sqme_tree_pos = 1
	call core%set_n_external (core%data%get_n_tot ())
	call core%prepare_library (os_data, model)
	call core%start ()
	call core%set_electroweak_parameters (model)
	select type (driver => core%driver)
	type is (openloops_driver_t)
	!!! We have to set the external vector boson wavefunction to the MadGraph convention
	!!! in order to be consistent with our calculation of the spin correlated contributions.
	call driver%blha_olp_set_parameter ('wf_v_select'//c_null_char, &
	3._double, 0._double, ierr)
	if (ierr == 0) call parameter_error_message (var_str ('wf_v_select'), &
	var_str ('prc_openloops_prepare_external_code'))
	end select
	call core%read_contract_file (flv_states)
	call core%print_parameter_file (i_core)
	end subroutine prc_openloops_prepare_external_code

	@ %def prc_openloops_prepare_external_code
	@ Computes a spin-correlated matrix element from an interface to an
	external one-loop provider. The output of [[blha_olp_eval2]] is
	an array of [[dimension(16)]]. The current interface does not
	give out an accuracy, so that [[bad_point]] is always [[.false.]].
	OpenLoops includes a factor of 1 / [[n_hel]] in the
	amplitudes, which we have to undo if polarized matrix elements
	are requested.
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: compute_sqme_spin_c => prc_openloops_compute_sqme_spin_c
	<<Prc openloops: sub interfaces>>=
	module subroutine prc_openloops_compute_sqme_spin_c (object, &
	i_flv, i_hel, em, p, ren_scale, sqme_spin_c, bad_point)
	class(prc_openloops_t), intent(inout) :: object
	integer, intent(in) :: i_flv, i_hel
	integer, intent(in) :: em
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out), dimension(6) :: sqme_spin_c
	logical, intent(out) :: bad_point
	end subroutine prc_openloops_compute_sqme_spin_c
	<<Prc openloops: procedures>>=
	module subroutine prc_openloops_compute_sqme_spin_c (object, &
	i_flv, i_hel, em, p, ren_scale, sqme_spin_c, bad_point)
	class(prc_openloops_t), intent(inout) :: object
	integer, intent(in) :: i_flv, i_hel
	integer, intent(in) :: em
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: ren_scale
	real(default), intent(out), dimension(6) :: sqme_spin_c
	logical, intent(out) :: bad_point
	real(default), dimension(16) :: sqme_spin_c_tmp
	real(double), dimension(5*N_EXTERNAL) :: mom
	real(double) :: res
	real(double), dimension(16) :: res_munu
	real(default) :: alpha_s
	if (object%i_spin_c(i_flv, i_hel) >= 0) then
	mom = object%create_momentum_array (p)
	if (vanishes (ren_scale)) call msg_fatal &
	("prc_openloops_compute_sqme_spin_c: ren_scale vanishes")
	alpha_s = object%qcd%alpha%get (ren_scale)
	select type (driver => object%driver)
	type is (openloops_driver_t)
	call driver%set_alpha_s (alpha_s)
	call driver%evaluate_spin_correlations_powheg &
	(object%i_spin_c(i_flv, i_hel), mom, em, res, res_munu)
	end select
	sqme_spin_c_tmp = res_munu
	bad_point = .false.
	if (object%includes_polarization ()) &
	sqme_spin_c_tmp = object%n_hel * sqme_spin_c_tmp
	if (debug_on) then
	if (sum(sqme_spin_c_tmp) == 0) then
	call msg_debug(D_SUBTRACTION,'Spin-correlated matrix elements provided by OpenLoops are zero!')
	end if
	end if
	else
	sqme_spin_c_tmp = zero
	end if
	!!! Using symmetry of the 4x4 matrix of spin correlated squared Born MEs and
	!!! the fact that we multiply only with vectors with E=0. We thus store the
	!!! upper triangle of the lower 3x3 matrix as columns in a 1-dim array
	sqme_spin_c(1:2) = sqme_spin_c_tmp(6:7)
	sqme_spin_c(3) = sqme_spin_c_tmp(11)
	sqme_spin_c(4) = sqme_spin_c_tmp(8)
	sqme_spin_c(5) = sqme_spin_c_tmp(12)
	sqme_spin_c(6) = sqme_spin_c_tmp(16)
	end subroutine prc_openloops_compute_sqme_spin_c

	@ %def prc_openloops_compute_sqme_spin_c
	@
	<<Prc openloops: prc openloops: TBP>>=
	procedure :: get_alpha_qed => prc_openloops_get_alpha_qed
	<<Prc openloops: sub interfaces>>=
	module function prc_openloops_get_alpha_qed &
	(object, core_state) result (alpha_qed)
	class(prc_openloops_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(default) :: alpha_qed
	end function prc_openloops_get_alpha_qed
	<<Prc openloops: procedures>>=
	module function prc_openloops_get_alpha_qed &
	(object, core_state) result (alpha_qed)
	class(prc_openloops_t), intent(in) :: object
	class(prc_core_state_t), intent(in), allocatable :: core_state
	real(double) :: value
	real(default) :: alpha_qed
	select type (driver => object%driver)
	type is (openloops_driver_t)
	call driver%get_parameter_double ('alpha_qed'//c_null_char, value)
	alpha_qed = value
	return
	end select
	call msg_fatal ("prc_openloops_get_alpha_qed: " // &
	"called by wrong driver, only supported for OpenLoops!")
	end function prc_openloops_get_alpha_qed

	@ %def prc_openloops_get_alpha_qed
	Index: trunk/share/tests/unit_tests/ref-output/blha_1.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/blha_1.ref (revision 8903)
	+++ trunk/share/tests/unit_tests/ref-output/blha_1.ref (revision 8904)
	@@ -1,229 +1,229 @@
	* Test output: blha_1
	* Purpose: Test the creation of olp-files for single "and unpolarized flavor structures

	* Process: e+ e- -> W+ W- b b~
	* BLHA matrix elements assumed for all process components
	* Mode: GoSam
	------------------------------------------------------------------------
	OLP-File content for loop matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_LOOP
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 0
	CouplingPower QED 4
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Loop
	11 -11 -> 24 -24 5 -5

	AmplitudeType ccTree
	11 -11 -> 24 -24 5 -5

	------------------------------------------------------------------------
	OLP-File content for subtraction matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_SUB
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 0
	CouplingPower QED 4
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5

	AmplitudeType ccTree
	11 -11 -> 24 -24 5 -5

	-AmplitudeType scTree
	+AmplitudeType scTree2
	11 -11 -> 24 -24 5 -5

	------------------------------------------------------------------------
	OLP-File content for real matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_REAL
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 1
	CouplingPower QED 4
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5 21

	------------------------------------------------------------------------
	OLP-File content for born matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_BORN
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 0
	CouplingPower QED 4
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5

	* Switch to OpenLoops
	------------------------------------------------------------------------
	OLP-File content for loop matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_LOOP
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_LOOP.olc
	IRregularisation CDR
	CouplingPower QCD 0
	CouplingPower QED 4
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Loop
	11 -11 -> 24 -24 5 -5

	AmplitudeType ccTree
	11 -11 -> 24 -24 5 -5

	------------------------------------------------------------------------
	OLP-File content for subtraction matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_SUB
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_SUB.olc
	IRregularisation CDR
	CouplingPower QCD 0
	CouplingPower QED 4
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5

	AmplitudeType ccTree
	11 -11 -> 24 -24 5 -5

	AmplitudeType sctree_polvect
	11 -11 -> 24 -24 5 -5

	------------------------------------------------------------------------
	OLP-File content for real matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_REAL
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_REAL.olc
	IRregularisation CDR
	CouplingPower QCD 1
	CouplingPower QED 4
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5 21

	------------------------------------------------------------------------
	OLP-File content for born matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_BORN
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_BORN.olc
	IRregularisation CDR
	CouplingPower QCD 0
	CouplingPower QED 4
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5

	Index: trunk/share/tests/unit_tests/ref-output/blha_2.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/blha_2.ref (revision 8903)
	+++ trunk/share/tests/unit_tests/ref-output/blha_2.ref (revision 8904)
	@@ -1,313 +1,313 @@
	* Test output: blha_2
	* Purpose: Test the creation of olp-files for multiple "and unpolarized flavor structures

	* Process: e+ e- -> u:d:s U:D:S
	* BLHA matrix elements assumed for all process components
	* Mode: GoSam
	------------------------------------------------------------------------
	OLP-File content for loop matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_LOOP
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 0
	CouplingPower QED 2
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Loop
	11 -11 -> 1 -1

	AmplitudeType ccTree
	11 -11 -> 1 -1

	AmplitudeType Loop
	11 -11 -> 2 -2

	AmplitudeType ccTree
	11 -11 -> 2 -2

	AmplitudeType Loop
	11 -11 -> 3 -3

	AmplitudeType ccTree
	11 -11 -> 3 -3

	------------------------------------------------------------------------
	OLP-File content for subtraction matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_SUB
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 0
	CouplingPower QED 2
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Tree
	11 -11 -> 1 -1

	AmplitudeType ccTree
	11 -11 -> 1 -1

	-AmplitudeType scTree
	+AmplitudeType scTree2
	11 -11 -> 1 -1

	AmplitudeType Tree
	11 -11 -> 2 -2

	AmplitudeType ccTree
	11 -11 -> 2 -2

	-AmplitudeType scTree
	+AmplitudeType scTree2
	11 -11 -> 2 -2

	AmplitudeType Tree
	11 -11 -> 3 -3

	AmplitudeType ccTree
	11 -11 -> 3 -3

	-AmplitudeType scTree
	+AmplitudeType scTree2
	11 -11 -> 3 -3

	------------------------------------------------------------------------
	OLP-File content for real matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_REAL
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 1
	CouplingPower QED 2
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Tree
	11 -11 -> 1 -1 21

	AmplitudeType Tree
	11 -11 -> 2 -2 21

	AmplitudeType Tree
	11 -11 -> 3 -3 21

	------------------------------------------------------------------------
	OLP-File content for born matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_BORN
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 0
	CouplingPower QED 2
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Tree
	11 -11 -> 1 -1

	AmplitudeType Tree
	11 -11 -> 2 -2

	AmplitudeType Tree
	11 -11 -> 3 -3

	* Switch to OpenLoops
	------------------------------------------------------------------------
	OLP-File content for loop matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_LOOP
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_LOOP.olc
	IRregularisation CDR
	CouplingPower QCD 0
	CouplingPower QED 2
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Loop
	11 -11 -> 1 -1

	AmplitudeType ccTree
	11 -11 -> 1 -1

	AmplitudeType Loop
	11 -11 -> 2 -2

	AmplitudeType ccTree
	11 -11 -> 2 -2

	AmplitudeType Loop
	11 -11 -> 3 -3

	AmplitudeType ccTree
	11 -11 -> 3 -3

	------------------------------------------------------------------------
	OLP-File content for subtraction matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_SUB
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_SUB.olc
	IRregularisation CDR
	CouplingPower QCD 0
	CouplingPower QED 2
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Tree
	11 -11 -> 1 -1

	AmplitudeType ccTree
	11 -11 -> 1 -1

	AmplitudeType sctree_polvect
	11 -11 -> 1 -1

	AmplitudeType Tree
	11 -11 -> 2 -2

	AmplitudeType ccTree
	11 -11 -> 2 -2

	AmplitudeType sctree_polvect
	11 -11 -> 2 -2

	AmplitudeType Tree
	11 -11 -> 3 -3

	AmplitudeType ccTree
	11 -11 -> 3 -3

	AmplitudeType sctree_polvect
	11 -11 -> 3 -3

	------------------------------------------------------------------------
	OLP-File content for real matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_REAL
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_REAL.olc
	IRregularisation CDR
	CouplingPower QCD 1
	CouplingPower QED 2
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Tree
	11 -11 -> 1 -1 21

	AmplitudeType Tree
	11 -11 -> 2 -2 21

	AmplitudeType Tree
	11 -11 -> 3 -3 21

	------------------------------------------------------------------------
	OLP-File content for born matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_BORN
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_BORN.olc
	IRregularisation CDR
	CouplingPower QCD 0
	CouplingPower QED 2
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Tree
	11 -11 -> 1 -1

	AmplitudeType Tree
	11 -11 -> 2 -2

	AmplitudeType Tree
	11 -11 -> 3 -3

	Index: trunk/share/tests/unit_tests/ref-output/blha_3.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/blha_3.ref (revision 8903)
	+++ trunk/share/tests/unit_tests/ref-output/blha_3.ref (revision 8904)
	@@ -1,229 +1,229 @@
	* Test output: blha_3
	* Purpose: Test the creation of olp-files for single "and polarized flavor structures

	* Process: e+ e- -> W+ W- b b~
	* BLHA matrix elements assumed for all process components
	* Mode: GoSam
	------------------------------------------------------------------------
	OLP-File content for loop matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_LOOP
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 0
	CouplingPower QED 4
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Loop
	11 -11 -> 24 -24 5 -5

	AmplitudeType ccTree
	11 -11 -> 24 -24 5 -5

	------------------------------------------------------------------------
	OLP-File content for subtraction matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_SUB
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 0
	CouplingPower QED 4
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5

	AmplitudeType ccTree
	11 -11 -> 24 -24 5 -5

	-AmplitudeType scTree
	+AmplitudeType scTree2
	11 -11 -> 24 -24 5 -5

	------------------------------------------------------------------------
	OLP-File content for real matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_REAL
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 1
	CouplingPower QED 4
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5 21

	------------------------------------------------------------------------
	OLP-File content for born matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: GoSam
	# process: BLHA_Test_BORN
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	IRregularisation CDR
	MassiveParticleScheme OnShell
	CouplingPower QCD 0
	CouplingPower QED 4
	EWScheme alphaGF
	MassiveParticles 5 6 13 15 23 24 25

	# Process definitions

	DebugUnstable True

	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5

	* Switch to OpenLoops
	------------------------------------------------------------------------
	OLP-File content for loop matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_LOOP
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_LOOP.olc
	IRregularisation CDR
	CouplingPower QCD 0
	CouplingPower QED 4
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Loop
	11 -11 -> 24 -24 5 -5

	AmplitudeType ccTree
	11 -11 -> 24 -24 5 -5

	------------------------------------------------------------------------
	OLP-File content for subtraction matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_SUB
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_SUB.olc
	IRregularisation CDR
	CouplingPower QCD 0
	CouplingPower QED 4
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5

	AmplitudeType ccTree
	11 -11 -> 24 -24 5 -5

	AmplitudeType sctree_polvect
	11 -11 -> 24 -24 5 -5

	------------------------------------------------------------------------
	OLP-File content for real matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_REAL
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_REAL.olc
	IRregularisation CDR
	CouplingPower QCD 1
	CouplingPower QED 4
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5 21

	------------------------------------------------------------------------
	OLP-File content for born matrix elements
	------------------------------------------------------------------------
	# BLHA order written by WHIZARD [version]

	# BLHA interface mode: OpenLoops
	# process: BLHA_Test_BORN
	# model: SM
	InterfaceVersion BLHA2
	CorrectionType QCD
	Extra AnswerFile BLHA_Test_BORN.olc
	IRregularisation CDR
	CouplingPower QCD 0
	CouplingPower QED 4
	ewscheme Gmu
	extra use_cms 0
	extra me_cache 0
	extra IR_on 0
	extra psp_tolerance 10e-7


	# Process definitions


	AmplitudeType Tree
	11 -11 -> 24 -24 5 -5

	Index: trunk/share/doc/manual.tex
	===================================================================
	--- trunk/share/doc/manual.tex (revision 8903)
	+++ trunk/share/doc/manual.tex (revision 8904)
	@@ -1,19173 +1,19175 @@
	\documentclass[12pt]{book}
	% \usepackage{feynmp}
	\usepackage{microtype}
	\usepackage{graphics,graphicx}
	\usepackage{color}
	\usepackage{amsmath,amssymb}
	\usepackage[colorlinks,bookmarks,bookmarksnumbered=true]{hyperref}
	\usepackage{thophys}
	\usepackage{fancyvrb}
	\usepackage{makeidx}
	\usepackage{units}
	\usepackage{ifpdf}
	+\usepackage[T1]{fontenc}
	%HEVEA\pdftrue
	\makeindex
	\usepackage{url}
	\usepackage[latin1]{inputenc}
	%HEVEA\@def@charset{UTF-8}
	%BEGIN LATEX
	\usepackage{supertabular,fancyvrb}
	\usepackage[T1]{fontenc}
	\usepackage{hevea}
	%END LATEX
	\renewcommand{\topfraction}{0.9}
	\renewcommand{\bottomfraction}{0.8}
	\renewcommand{\textfraction}{0.1}
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%% Macro section
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\newcommand{\email}[2]{\thanks{\ahref{#1@{}#2}{#1@{}#2}}}
	\newcommand{\hepforgepage}{\url{https://whizard.hepforge.org}}
	\newcommand{\whizardwiki}{\url{https://whizard.hepforge.org/trac/wiki}}
	\tocnumber
	%BEGIN LATEX
	\DeclareMathOperator{\diag}{diag}
	%END LATEX
	%BEGIN LATEX
	\makeatletter
	\newif\if@preliminary
	\@preliminaryfalse
	\def\preliminary{\@preliminarytrue}
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%% Changes referring to article.cls
	%
	%%% Title page
	\def\preprintno#1{\def\@preprintno{#1}}
	\def\address#1{\def\@address{#1}}
	\def\email#1#2{\thanks{\tt #1@{}#2}}
	\def\abstract#1{\def\@abstract{#1}}
	\newcommand\abstractname{ABSTRACT}
	\newlength\preprintnoskip
	\setlength\preprintnoskip{\textwidth\@plus -1cm}
	\newlength\abstractwidth
	\setlength\abstractwidth{\textwidth\@plus -3cm}
	%
	\@titlepagetrue
	\renewcommand\maketitle{\begin{titlepage}%
	\let\footnotesize\small
	\hfill\parbox{\preprintnoskip}{%
	\begin{flushright}\@preprintno\end{flushright}}\hspace*{1cm}
	\vskip 60\p@
	\begin{center}%
	{\Large\bf\boldmath \@title \par}\vskip 1cm%
	{\sc\@author \par}\vskip 3mm%
	{\@address \par}%
	\if@preliminary
	\vskip 2cm {\large\sf PRELIMINARY DRAFT \par \@date}%
	\fi
	\end{center}\par
	\@thanks
	\vfill
	\begin{center}%
	\parbox{\abstractwidth}{\centerline{\abstractname}%
	\vskip 3mm%
	\@abstract}
	\end{center}
	\end{titlepage}%
	\setcounter{footnote}{0}%
	\let\thanks\relax\let\maketitle\relax
	\gdef\@thanks{}\gdef\@author{}\gdef\@address{}%
	\gdef\@title{}\gdef\@abstract{}\gdef\@preprintno{}
	}%
	%
	%%% New settings of dimensions
	\topmargin -1.5cm
	\textheight 22cm
	\textwidth 17cm
	\oddsidemargin 0cm
	\evensidemargin 0cm
	%
	%%% Original Latex definition of citex, except for the removal of
	%%% 'space' following a ','. \citerange replaces the ',' by '--'.
	\def\@citex[#1]#2{\if@filesw\immediate\write\@auxout{\string\citation{#2}}\fi
	\def\@citea{}\@cite{\@for\@citeb:=#2\do
	{\@citea\def\@citea{,\penalty\@m}\@ifundefined
	{b@\@citeb}{{\bf ?}\@warning
	{Citation `\@citeb' on page \thepage \space undefined}}%
	\hbox{\csname b@\@citeb\endcsname}}}{#1}}
	\def\citerange{\@ifnextchar [{\@tempswatrue\@citexr}{\@tempswafalse\@citexr[]}}
	\def\@citexr[#1]#2{\if@filesw\immediate\write\@auxout{\string\citation{#2}}\fi
	\def\@citea{}\@cite{\@for\@citeb:=#2\do
	{\@citea\def\@citea{--\penalty\@m}\@ifundefined
	{b@\@citeb}{{\bf ?}\@warning
	{Citation `\@citeb' on page \thepage \space undefined}}%
	\hbox{\csname b@\@citeb\endcsname}}}{#1}}
	%
	%%% Captions set in italics
	\long\def\@makecaption#1#2{%
	\vskip\abovecaptionskip
	\sbox\@tempboxa{#1: \emph{#2}}%
	\ifdim \wd\@tempboxa >\hsize
	#1: \emph{#2}\par
	\else
	\hbox to\hsize{\hfil\box\@tempboxa\hfil}%
	\fi
	\vskip\belowcaptionskip}
	%
	%%% Other useful macros
	\def\fmslash{\@ifnextchar[{\fmsl@sh}{\fmsl@sh[0mu]}}
	\def\fmsl@sh[#1]#2{%
	\mathchoice
	{\@fmsl@sh\displaystyle{#1}{#2}}%
	{\@fmsl@sh\textstyle{#1}{#2}}%
	{\@fmsl@sh\scriptstyle{#1}{#2}}%
	{\@fmsl@sh\scriptscriptstyle{#1}{#2}}}
	\def\@fmsl@sh#1#2#3{\m@th\ooalign{$\hfil#1\mkern#2/\hfil$\crcr$#1#3$}}
	\makeatother

	% Labelling command for Feynman graphs generated by package FEYNMF
	%\def\fmfL(#1,#2,#3)#4{\put(#1,#2){\makebox(0,0)[#3]{#4}}}

	%END LATEX
	%%%% Environment for showing user input and program response
	\newenvironment{interaction}%
	{\begingroup\small
	\Verbatim}%
	{\endVerbatim
	\endgroup\noindent}
	%BEGIN LATEX

	%%%% Environment for typesetting listings verbatim
	\newenvironment{code}%
	{\begingroup\footnotesize
	\quote
	\Verbatim}%
	{\endVerbatim
	\endquote
	\endgroup\noindent}

	%%%% Boxed environment for typesetting listings verbatim
	\newenvironment{Code}%
	{\begingroup\footnotesize
	\quote
	\Verbatim[frame=single]}%
	{\endVerbatim
	\endquote
	\endgroup\noindent}

	%%% Environment for displaying syntax
	\newenvironment{syntax}%
	{\begin{quote}
	\begin{flushleft}\tt}%
	{\end{flushleft}
	\end{quote}}
	\newcommand{\var}[1]{$\langle$\textit{#1}$\rangle$}


	%END LATEX
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	% Macros specific for this paper
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\newcommand{\ttt}[1]{\texttt{#1}}
	\newcommand{\whizard}{\ttt{WHIZARD}}
	\newcommand{\oMega}{\ttt{O'Mega}}
	\newcommand{\vamp}{\ttt{VAMP}}
	\newcommand{\vamptwo}{\ttt{VAMP2}}
	\newcommand{\vegas}{\ttt{VEGAS}}
	\newcommand{\madgraph}{\ttt{MadGraph}}
	\newcommand{\CalcHep}{\ttt{CalcHep}}
	\newcommand{\helas}{\ttt{HELAS}}
	\newcommand{\herwig}{\ttt{HERWIG}}
	\newcommand{\isajet}{\ttt{ISAJET}}
	\newcommand{\pythia}{\ttt{PYTHIA}}
	\newcommand{\pythiasix}{\ttt{PYTHIA6}}
	\newcommand{\pythiaeight}{\ttt{PYTHIA8}}
	\newcommand{\jetset}{\ttt{JETSET}}
	\newcommand{\comphep}{\ttt{CompHEP}}
	\newcommand{\circe}{\ttt{CIRCE}}
	\newcommand{\circeone}{\ttt{CIRCE1}}
	\newcommand{\circetwo}{\ttt{CIRCE2}}
	\newcommand{\gamelan}{\textsf{gamelan}}
	\newcommand{\stdhep}{\ttt{STDHEP}}
	\newcommand{\lcio}{\ttt{LCIO}}
	\newcommand{\pdflib}{\ttt{PDFLIB}}
	\newcommand{\lhapdf}{\ttt{LHAPDF}}
	\newcommand{\hepmc}{\ttt{HepMC}}
	\newcommand{\hepmcthree}{\ttt{HepMC3}}
	\newcommand{\fastjet}{\ttt{FastJet}}
	\newcommand{\hoppet}{\ttt{HOPPET}}
	\newcommand{\metapost}{\ttt{MetaPost}}
	\newcommand{\sarah}{\ttt{SARAH}}
	\newcommand{\spheno}{\ttt{SPheno}}
	\newcommand{\Mathematica}{\ttt{Mathematica}}
	\newcommand{\FeynRules}{\ttt{FeynRules}}
	\newcommand{\UFO}{\ttt{UFO}}
	\newcommand{\gosam}{\ttt{Gosam}}
	\newcommand{\openloops}{\ttt{OpenLoops}}
	\newcommand{\recola}{\ttt{Recola}}
	\newcommand{\collier}{\ttt{Collier}}
	\newcommand{\powheg}{\ttt{POWHEG}}
	\newcommand{\delphes}{\ttt{Delphes}}
	\newcommand{\geant}{\ttt{Geant}}
	\newcommand{\ROOT}{\ttt{ROOT}}
	\newcommand{\rivet}{\ttt{Rivet}}
	%%%%%
	\newcommand{\sindarin}{\ttt{SINDARIN}}
	\newcommand{\cpp}{\ttt{C++}}
	\newcommand{\fortran}{\ttt{Fortran}}
	\newcommand{\fortranSeventySeven}{\ttt{FORTRAN77}}
	\newcommand{\fortranNinetyFive}{\ttt{Fortran95}}
	\newcommand{\fortranOThree}{\ttt{Fortran2003}}
	\newcommand{\ocaml}{\ttt{OCaml}}
	\newcommand{\python}{\ttt{Python}}

	\newenvironment{commands}{\begin{quote}\tt}{\end{quote}}
	\newcommand{\eemm}{$e^+e^- \to \mu^+\mu^-$}

	%\def\~{$\sim$}
	\newcommand{\sgn}{\mathop{\rm sgn}\nolimits}
	\newcommand{\GeV}{\textrm{GeV}}
	\newcommand{\fb}{\textrm{fb}}
	\newcommand{\ab}{\textrm{ab}}

	\newenvironment{parameters}{%
	\begin{center}
	\begin{tabular}{lccp{65mm}}
	\hline
	Parameter & Value & Default & Description \\
	\hline
	}{%
	\hline
	\end{tabular}
	\end{center}
	}

	\newenvironment{options}{%
	\begin{center}
	\begin{tabular}{llcp{80mm}}
	\hline
	Option & Long version & Value & Description \\
	\hline
	}{%
	\hline
	\end{tabular}
	\end{center}
	}

	%BEGIN LATEX
	\renewenvironment{options}{%
	\begin{center}
	\tablehead{\hline
	Option & Long version & Value & Description \\
	\hline
	}
	\begin{supertabular}{llcp{80mm}}
	}{%
	\hline
	\end{supertabular}
	\end{center}
	}
	%END LATEX

	%BEGIN LATEX
	\renewenvironment{parameters}{%
	\begin{center}
	\tablehead{\hline
	Parameter & Value & Default & Description \\
	\hline
	}
	\begin{supertabular}{lccp{65mm}}
	}{%
	\hline
	\end{supertabular}
	\end{center}
	}
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%END LATEX
	\newcommand{\thisversion}{3.1.3}
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\begin{document}
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%BEGIN LATEX
	\preprintno{}
	%%%\preprintno{arXiv:0708.4233 (also based on LC-TOOL-2001-039 (revised))}
	%END LATEX
	\title{%
	%HEVEA WHIZARD 3.1 \\
	%BEGIN LATEX
	\ttt{\huge WHIZARD 3.1} \\[\baselineskip]
	%END LATEX
	A generic \\ Monte-Carlo integration and event generation package \\
	for multi-particle processes\\[\baselineskip]
	MANUAL
	\footnote{%
	This work is supported by the Deutsche Forschungsgemeinschaft (DFG,
	German Research Association) under Germany's Excellence Strategy-EXC
	2121 ``Quantum Universe''-39083330 and under grant 396021762 - TRR 257.
	In the past it was supported by Helmholtz-Alliance ``Physics at the
	Terascale''. In former stages this work has also been supported by
	the Helmholtz-Gemeinschaft VH--NG--005 \\
	E-mail: \ttt{whizard@desy.de}
	}
	\\[\baselineskip]
	}
	% \def\authormail{\ttt{kilian@physik.uni-siegen.de},
	% \ttt{ohl@physik.uni-wuerzburg.de},
	% \ttt{juergen.reuter@desy.de}, \ttt{cnspeckn@googlemail.com}}
	\author{%
	Wolfgang Kilian, %
	Thorsten Ohl, %
	J\"urgen Reuter, %
	with contributions from
	Fabian Bach, %
	Timothy L. Barklow, %
	Mikael Berggren, %
	Simon Bra\ss, %
	Pia Mareen Bredt, %
	Bijan Chokouf\'{e} Nejad, %
	Oliver Fischer, %
	Christian Fleper, %
	+ Marius H\"ofer, %
	Maximilian L\"oschner, %
	Krzysztof~M\k{e}ka{\l}a, %
	Akiya Miyamoto, %
	Vincent Rothe, %
	Sebastian Schmidt, %
	Marco Sekulla, %
	- Christian Speckner, %
	So Young Shim, %
	+ Christian Speckner, %
	Florian Staub, %
	Pascal Stienemeier, %
	Manuel Utsch, %
	Christian Weiss, %
	Aleksander Filip \.Zarnecki, %
	Zhijie Zhao}

	%BEGIN LATEX
	\address{%
	Universit\"at Siegen, Emmy-Noether-Campus, Walter-Flex-Str. 3,
	D--57068 Siegen, Germany \\
	Universit\"at W\"urzburg, Emil-Hilb-Weg 22,
	D--97074 W\"urzburg, Germany \\
	Deutsches Elektronen-Synchrotron DESY, Notkestr. 85,
	D--22603 Hamburg, Germany \\
	%% \authormail
	\vspace{1cm}
	\begin{center}
	\includegraphics[width=4cm]{Whizard-Logo}
	\end{center}
	\mbox{} \\
	\vspace{2cm}
	\mbox{} when using \whizard\ please cite: \\
	W. Kilian, T. Ohl, J. Reuter, \\ {\em WHIZARD: Simulating Multi-Particle
	Processes at LHC and ILC}, \\
	Eur.Phys.J.{\bf C71} (2011) 1742, arXiv:
	0708.4233 [hep-ph]; \\
	M. Moretti, T. Ohl, J. Reuter, \\ {\em O'Mega: An Optimizing Matrix
	Element Generator}, \\
	arXiv: hep-ph/0102195
	}
	%END LATEX
	%BEGIN LATEX
	\abstract{%
	\whizard\ is a program system designed for the efficient calculation
	of multi-particle scattering cross sections and simulated event
	samples. The generated events can be written to file in various formats
	(including HepMC, LHEF, STDHEP, LCIO, and ASCII) or analyzed directly on the
	parton or hadron level using a built-in \LaTeX-compatible graphics
	package.
	\\[\baselineskip]
	Complete tree-level matrix elements are generated automatically for arbitrary
	partonic multi-particle processes by calling the built-in matrix-element
	generator \oMega. Beyond hard matrix elements, \whizard\ can generate
	(cascade) decays with complete spin correlations.
	Various models beyond the SM are implemented, in particular,
	the MSSM is supported with an interface to the SUSY Les Houches Accord
	input format. Matrix elements obtained by alternative methods (e.g.,
	including loop corrections) may be interfaced as well.
	\\[\baselineskip]
	The program uses an adaptive multi-channel method for phase space
	integration, which allows to calculate numerically stable signal and
	background cross sections and generate unweighted event samples with
	reasonable efficiency for processes with up to eight and more
	final-state particles. Polarization is treated exactly for both the
	initial and final states. Quark or lepton flavors can be
	summed over automatically where needed.
	\\[\baselineskip]
	For hadron collider physics, we ship the package with the most recent
	PDF sets from the MSTW/MMHT and CTEQ/CT10/CJ12/CJ15/CT14
	collaborations. Furthermore, an interface to the \lhapdf\ library is
	provided.
	\\[\baselineskip]
	For Linear Collider physics,
	beamstrahlung (\circeone, \circetwo), Compton and ISR spectra are
	included for electrons and photons, including the most recent ILC and
	CLIC collider designs. Alternatively, beam-crossing events can be read
	directly from file.
	\\[\baselineskip]
	For parton showering and matching/merging with hard matrix elements ,
	fragmenting and hadronizing the final state, a first version of two
	different parton shower algorithms are included in the \whizard\
	package. This also includes infrastructure for the MLM matching and
	merging algorithm. For hadronization and hadronic decays, \pythia\
	and \herwig\ interfaces are provided which follow the Les Houches
	Accord. In addition, the last and final version of (\fortran) \pythia\
	is included in the package.
	\\[\baselineskip]
	The \whizard\ distribution is available at
	%%% \begin{center}
	%%% \ttt{http://whizard.event-generator.org}
	%%% \end{center}
	%%% or at
	\begin{center}
	\url{https://whizard.hepforge.org}
	\end{center}
	where also the \ttt{svn} repository is located.
	}
	%END LATEX
	%
	\maketitle


	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%% Text
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%\begin{fmffile}
	\tableofcontents

	\newpage
	\chapter{Introduction}

	\section{Disclaimer}

	\emph{This is a preliminary version of the WHIZARD manual. Many parts
	are still missing or incomplete, and some parts will be rewritten and
	improved soon. To find updated versions of the manual,
	visit the \whizard\ website}
	\begin{center}
	\hepforgepage
	\end{center}
	\emph{or consult the current version in the \ttt{svn} repository
	on \hepforgepage\ directly. Note, that the most recent version of
	the manual might contain information about features of the
	current \ttt{svn} version, which are not contained in the last
	official release version!}

	\emph{For information that is not (yet) written in the manual, please
	consult the examples in the \whizard\ distribution. You will find these in
	the subdirectory \ttt{share/examples} of the main directory where
	\whizard\ is installed. More information about the examples can be
	found on the \whizard\ Wiki page}
	\begin{center}
	\whizardwiki .
	\end{center}

	%%%%%

	\clearpage
	\section{Overview}

	\whizard\ is a multi-purpose event generator that covers all parts of
	event generation (unweighted and weighted), either through intrinsic
	components or interfaces to external packages. Realistic collider
	environments are covered through sophisticated descriptions for beam
	structures at hadron colliders, lepton colliders, lepton-hadron
	colliders, both circular and linear machines. Other options include
	scattering processes e.g. for dark matter annihilation or particle
	decays. \whizard\ contains its in-house generator for (tree-level)
	high-multiplicity matrix elements, \oMega\, that supports the whole
	Standard Model (SM) of particle physics and basically all possibile
	extensions of it. QCD parton shower describe high-multiplicity
	partonic jet events that can be matched with matrix elements. At the
	moment, only hadron collider parton distribution functions (PDFs) and
	hadronization are handled by packages not written by the main
	authors.

	This manual is organized mainly along the lines of the way how to run
	\whizard: this is done through a command language, \sindarin\ (Scripting
	INtegration, Data Analysis, Results display and INterfaces.) Though
	this seems a complication at first glance, the user is rewarded with a
	large possibility, flexibility and versatility on how to steer
	\whizard.

	After some general remarks in the follow-up sections, in
	Chap.~\ref{chap:installation} we describe how to get the program, the
	package structure, the prerequisites, possible external extensions of
	the program and the basics of the installation (both as superuser and
	locally). Also, a first technical overview how to work with \whizard\
	on single computer, batch clusters and farms are given. Furthermore,
	some rare uncommon possible build problems are discussed, and a tour
	through options for debugging, testing and validation is being made.

	A first dive into the running of the program is made in
	Chap.~\ref{chap:start}. This is following by an extensive, but rather
	technical introduction into the steering language \sindarin\ in
	Chap.~\ref{chap:sindarinintro}. Here, the basic elements of the
	language like commands, statements, control structures, expressions
	and variables as well as the form of warnings and error messages are
	explained in detail.

	Chap.~\ref{chap:sindarin} contains the application of the \sindarin\
	command language to the main tasks in running \whizard\ in a physics
	framework: the defintion of particles, subevents, cuts, and event
	selections. The specification of a particular physics models is
	\begin{figure}[t]
	\centering
	\includegraphics[width=0.9\textwidth]{whizstruct}
	\caption{General structure of the \whizard\ package.}
	\end{figure}
	discussed, while the next sections are devoted to the setup and
	compilation of code for particular processes, the specification of
	beams, beam structure and polarization. The next step is the
	integration, controlling the integration, phase space, generator cuts,
	scales and weights, proceeding further to event generation and
	decays. At the end of this chapter, \whizard's internal data analysis
	methods and graphical visualization options are documented.

	The following chapters are dedicated to the physics implemented in
	\whizard: methods for hard matrix interactions in
	Chap.~\ref{chap:hardint}. Then, in Chap.~\ref{chap:physics},
	implemented methods for adaptive multi-channel integration,
	particularly the integrator \vamp\ are explained, together with the
	algorithms for the generation of the phase-space in \whizard. Finally,
	an overview is given over the physics models implemented in \whizard\
	and its matrix element generator \oMega, together with possibilities
	for their extension. After that, the next chapter discusses parton
	showering, matching and hadronization as well as options for event
	normalizations and supported event formats. Also weighted event
	generation is explained along the lines with options for negative
	weights.

	Chap.~\ref{chap:visualization} is a stand-alone documentation of
	GAMELAN, the interal graphics support for the visualization of data
	and analysis. The next chapter, Chap.~\ref{chap:userint} details user
	interfaces: how to use more options of the \whizard\ command on the
	command line, how to use \whizard\ interactively, and how to include
	\whizard\ as a library into the user's own program.

	Then, an extensive list of examples in Chap.~\ref{chap:examples}
	documenting physics examples from the LEP, SLC, HERA, Tevatron, and
	LHC colliders to future linear and circular colliders. This chapter is
	a particular good reference for the beginning, as the whole chain from
	choosing a model, setting up processes, the beam structure, the
	integration, and finally simulation and (graphical) analysis are
	explained in detail.

	More technical details about efficiency, tuning and advance usage of
	\whizard\ are collected in Chap.~\ref{chap:tuning}. Then,
	Chap.~\ref{chap:extmodels} shows how to set up your own new physics
	model with the help of external programs like \sarah\ or
	\FeynRules\ program or the Universal Feynrules Output, UFO, and
	include it into the \whizard\ event generator.

	In the appendices, we e.g. give an exhaustive reference list of
	\sindarin\ commands and built-in variables.

	Please report any inconsistencies, bugs, problems or simply pose open
	questions to our contact \url{whizard@desy.de}.

	There is now also a support page on \texttt{Launchpad}, which offers
	support that is easily visible for the whole user community:
	\url{https://launchpad.net/whizard}.



	%%%%%

	\section{Historical remarks}

	This section gives a historical overview over the development of
	\whizard\ and can be easily skipped in a (first) reading of the
	manual. \whizard\ has been developed in a first place as a tool for
	the physics at the then planned linear electron-positron collider
	TESLA around 1999. The intention was to have a tool at hand to
	describe electroweak physics of multiple weak bosons and the Higgs
	boson as precise as possible with full matrix elements. Hence, the
	acronym: \ttt{WHiZard}, which stood for $\mathbf{W}$, {\bf H}iggs,
	$\mathbf{Z}$, {\bf a}nd {\bf r}espective {\bf d}ecays.

	Several components of the \whizard\ package that are also available as
	independent sub-packages have been published already before the first
	versions of the \whizard\ generator itself: the multi-channel adaptive
	Monte-Carlo integration package \vamp\ has been released mid
	1998~\cite{VAMP}. The dedicated packages for the simulation of linear
	lepton collider beamstrahlung and the option for a photon collider on
	Compton backscattering (\ttt{CIRCE1/2}) date back even to mid
	1996~\cite{CIRCE}. Also parts of the code for \whizard's internal
	graphical analysis (the \gamelan\ module) came into existence already
	around 1998.

	After first inofficial versions, the official version 1 of \whizard\
	was release in the year 2000. The development, improvement and
	incorporation of new features continued for roughly a decade. Major
	milestones in the development were the full support of all kinds of
	beyond the Standard Model (BSM) models including spin 3/2 and spin 2
	particles and the inclusion of the MSSM, the NMSSM, Little Higgs
	models and models for anomalous couplings as well as extra-dimensional
	models from version 1.90 on. In the beginning, several methods for
	matrix elements have been used, until the in-house matrix element
	generator \oMega\ became available from version 1.20 on. It was
	included as a part of the \whizard\ package from version 1.90 on. The
	support for full color amplitudes came with version 1.50, but in a
	full-fledged version from 2.0 on. Version 1.40 brought the necessary
	setups for all kinds of collider environments, i.e. asymmetric beams,
	decay processes, and intrinsic $p_T$ in structure functions.

	Version 2.0 was released in April 2010 as an almost complete rewriting
	of the original code. It brought the construction of an internal
	density-matrix formalism which allowed the use of factorized
	production and (cascade) decay processes including complete color and
	spin correlations. Another big new feature was the command-line
	language \sindarin\ for steering all parts of the program. Also, many
	performance improvement have taken place in the new release series,
	like OpenMP parallelization, speed gain in matrix element generation
	etc. Version 2.2 came out in May 2014 as a major refactoring of the
	program internals but keeping (almost everywhere) the same user
	interface. New features are inclusive processes, reweighting, and more
	interfaces for QCD environments (BLHA/HOPPET).

	The following tables shows some of the major steps (physics
	implementation and/or technical improvements) in the development
	of \whizard (we break the table into logical and temporal blocks of
	\whizard\ development).

	\newpage

	{
	{\bf \whizard\ \texttt{1}}, first line of development, ca. 1998-2010:
	\nopagebreak[4]
	\begin{center}
	\begin{tabular}{\|l\|l\|l\|}\hline
	0.99 & 08/1999 & Beta version \\\hline
	1.00 & 12/2000 & First public version \\\hline
	1.10 & 03/2001 & Libraries; \pythiasix\ interface \\
	1.11 & 04/2001 & PDF support; anomalous couplings \\ \hline
	1.20 & 02/2002 & \oMega\ matrix elements; \ttt{CIRCE} support\\
	1.22 & 03/2002 & QED ISR; beam remnants, phase space improvements \\
	1.25 & 05/2003 & MSSM; weighted events; user-code plug-in \\
	1.28 & 04/2004 & Improved phase space; SLHA interface; signal catching
	\\\hline
	1.30 & 09/2004 & Major technical overhaul \\\hline
	1.40 & 12/2004 & Asymmetric beams; decays; $p_T$ in structure
	functions \\\hline
	1.50 & 02/2006 & QCD support in \oMega\ (color flows); LHA format \\
	1.51 & 06/2006 & $Hgg$, $H\gamma\gamma$; Spin 3/2 + 2; BSM models
	\\\hline
	1.90 & 11/2007 & \oMega\ included; LHAPDF support; $Z'$; $WW$ scattering \\
	1.92 & 03/2008 & LHE format; UED; parton shower beta version \\
	1.93 & 04/2009 & NMSSM; SLHA2 accord; improved color/flavor sums \\
	1.95 & 02/2010 & MLM matching; development stop in version 1
	\\
	1.97 & 05/2011 & Manual for version 1 completed. \\\hline\hline
	\end{tabular}
	\end{center}
	}

	\vspace{2cm}

	{
	{\bf \whizard\ \texttt{2.0-2.2}}: first major refactoring and early new
	release, ca. 2007-2015:
	\nopagebreak[4]
	\begin{center}
	\begin{tabular}{\|l\|l\|l\|}\hline
	2.0.0 & 04/2010 & Major refactoring: automake setup; dynamic
	libraries \\
	& & improved speed; cascades; OpenMP; \sindarin\ steering language \\
	2.0.3 & 07/2010 & QCD ISR+FSR shower; polarized beams \\
	2.0.5 & 05/2011 & Builtin PDFs; static builds; relocation scripts \\
	2.0.6 & 12/2011 & Anomalous top couplings; unit tests \\\hline
	2.1.0 & 06/2012 & Analytic ISR+FSR parton shower; anomalous Higgs
	couplings \\\hline
	2.2.0 & 05/2014 & Major technical refactoring: abstract
	object-orientation; THDM; \\
	& & reweighting; LHE v2/3; BLHA; HOPPET interface; inclusive
	processes \\
	2.2.1 & 05/2014 & CJ12 PDFs; FastJet interface \\
	2.2.2 & 07/2014 & LHAPDF6 support; correlated LC beams; GuineaPig
	interface \\
	2.2.3 & 11/2014 & O'Mega virtual machine; lepton collider top
	pair threshold; \\
	& & Higgs singlet extension \\
	2.2.4 & 02/2015 & LCIO support; progress on NLO; many technical
	bug fixes \\
	2.2.7 & 08/2015 & progress on POWHEG; fixed-order NLO events; \\
	& & revalidation of ILC event chain \\
	2.2.8 & 11/2015 & support for quadruple precision; StdHEP included; \\
	& & SM dim 6 operators supported
	\\\hline
	\end{tabular}
	\end{center}
	}

	\newpage

	{
	{\bf \whizard\ \texttt{2.3-2.8}}, completion of refactoring, continuous
	development, ca. 2015-2020:
	\nopagebreak[4]
	\begin{center}
	\begin{tabular}{\|l\|l\|l\|}\hline
	2.3.0 & 07/2016 & NLO: resonance mappings for FKS subtraction; \\
	& & more advanced cascade syntax; \\
	& & GUI ($\alpha$ version); UFO support
	($\alpha$ version); ILC v1.9x-v2.x final validation \\
	2.3.1 & 08/2016 & Complex mass scheme
	\\\hline
	2.4.0 & 11/2016 & Refactoring of NLO setup \\
	2.4.1 & 03/2017 & $\alpha$ version of new VEGAS implementation
	\\\hline
	2.5.0 & 05/2017 & Full UFO support (SM-like models)
	\\\hline
	2.6.0 & 09/2017 & MPI parallel integration and event generation;
	resonance histories \\
	& & for showers; RECOLA support \\
	2.6.1 & 11/2017 & EPA/ISR transverse distributions, handling of
	shower resonances; \\
	& & more efficient (alternative) phase space generation \\
	2.6.2 & 12/2017 & $Hee$ coupling, improved resonance matching \\
	2.6.3 & 02/2018 & Partial NLO refactoring for quantum numbers, \\
	& & unified RECOLA 1/2 interface. \\
	2.6.4 & 08/2018 & Gridpack functionality; Bug fixes: color flows,
	HSExt model, MPI setup
	\\\hline
	2.7.0 & 01/2019 & PYTHIA8 interface, process setup refactoring,
	RAMBO PS option; \\
	& & \quad gfortran 5.0+ necessary
	\\\hline
	2.8.0 & 08/2019 & (Almost) complete UFO support, general Lorentz
	structures, n-point vertices \\
	2.8.1 & 09/2019 & HepMC3, NLO QCD pp (almost)
	complete, b/c jet selection, photon isolation \\
	2.8.2 & 10/2019 & Support for OCaml $\geq$ 4.06.0, UFO Spin-2 support,
	LCIO alternative weights \\
	2.8.3 & 07/2020 & UFO Majorana feature complete, many $e^+e^-$ related
	improvements \\
	2.8.4 & 07/2020 & Bug fix for UFO Majorana models \\
	2.8.5 & 09/2020 & Bug fix for polarizations in $H\to\tau\tau$
	\\\hline\hline
	\end{tabular}
	\end{center}
	}

	\vspace{2cm}

	{
	{\bf \whizard\ \texttt{3.0}} and onwards, the NLO series:
	\nopagebreak[4]
	\begin{center}
	\begin{tabular}{\|l\|l\|l\|}\hline
	3.0.0 & 04/2021 & NLO QCD automation \& UFO Majorana support
	released
	\\
	3.0.1 & 07/2021 & MPI load balancer, rescan of ILC mass production
	samples
	\\
	3.0.2 & 11/2021 & NLO EW for $pp$ processes, sums/products in
	\sindarin\
	\\
	3.0.3 & 04/2022 & NLO EW/QCD mixed processes, NLL electron PDFs
	\\\hline
	3.1.0 & 12/2022 & General POWHEG matching (hadron/lepton colliders)
	\\
	3.1.2 & 03/2023 & Improved numerical stability for s-channel
	resonances
	\\
	3.1.3 & 10/2023 & New compiler requirements: gfortran 9.1.0+,
	OCaml 4.08+
	\\\hline\hline
	\end{tabular}
	\end{center}
	}

	\vspace{.5cm}

	For a detailed overview over the historical development of the code
	confer the \ttt{ChangeLog} file and the commit messages in our
	revision control system repository.

	\newpage

	%%%%%

	\section{About examples in this manual}

	Although \whizard\ has been designed as a Monte Carlo event generator
	for LHC physics, several elementary steps and aspects of its usage
	throughout the manual will be demonstrated with the famous textbook
	example of $e^+e^- \to \mu^+ \mu^-$. This is the same process, the
	textbook by Peskin/Schroeder \cite{PeskinSchroeder} uses as a prime
	example to teach the basics of quantum field theory. We use this
	example not because it is very special for \whizard\ or at the time
	being a relevant physics case, but simply because it is the easiest
	fundamental field theoretic process without the complications of
	structured beams (which can nevertheless be switched on like for ISR
	and beamstrahlung!), the need for jet definitions/algorithms and
	flavor sums; furthermore, it easily accomplishes a demonstration of
	polarized beams. After the basics of \whizard\ usage have been
	explained, we move on to actual physics cases from LHC (or Tevatron).


	\newpage
	\chapter{Installation}
	\label{chap:installation}

	\section{Package Structure}

	\whizard\ is a software package that consists of a main executable
	program (which is called \ttt{whizard}), libraries, auxiliary
	executable programs, and machine-independent data files. The whole
	package can be installed by the system administrator, by default, on a
	central location in the file system (\ttt{/usr/local} with its proper
	subdirectories). Alternatively, it is possible to install it in a
	user's home directory, without administrator privileges, or at any
	other location.

	A \whizard\ run requires a workspace, i.e., a writable directory where
	it can put generated code and data. There are no constraints on the
	location of this directory, but we recommend to use a separate
	directory for each \whizard\ project, or even for each \whizard\ run.

	Since \whizard\ generates the matrix elements for scattering and decay
	processes in form of \fortran\ code that is automatically compiled and
	dynamically linked into the running program, it requires a working
	\fortran\ compiler not just for the installation, but also at runtime.

	The previous major version \whizard1 did put more constraints on the
	setup. In a nutshell, not just the matrix element code was compiled
	at runtime, but other parts of the program as well, so the whole
	package was interleaved and had to be installed in user space. The
	workflow was controlled by \ttt{make} and PERL scripts. These
	constraints are gone in the present version in favor of a clean
	separation of installation and runtime workspace.


	\section{\label{sec:prerequisites}Prerequisites}

	\subsection{No Binary Distribution}

	\whizard\ is currently not distributed as a binary package, nor is it
	available as a debian or RPM package. This might change in the
	future. However, compiling from source is very simple (see below).
	Since the package needs a compiler also at runtime, it would not work
	without some development tools installed on the machine, anyway.

	Note, however, that we support an install script, that downloads all
	necessary prerequisites, and does the configuration and compilation
	described below automatically. This is called the ``instant WHIZARD''
	and is accessible through the WHIZARD webpage from version 2.1.1 on:
	\url{https://whizard.hepforge.org/versions/install/install-whizard-2.X.X.sh}.
	Download this shell script, make it executable by
	\begin{interaction}
	chmod +x install-whizard-2.X.X.sh
	\end{interaction}
	and execute it. Note that this also involves compilation of the
	required \fortran\ compiler which takes 1-3 hours depending on
	your system.
	\ttt{Darwin} operating systems (a.k.a. as \ttt{Mac OS X}) have a very
	similar general system for all sorts of software, called
	\ttt{MacPorts} (\url{http://www.macports.org}). This offers to install
	\whizard\ as one of its software ports, and is very similar to
	``instant WHIZARD'' described above.


	\subsection{Tarball Distribution}
	\label{sec:tarballdistr}

	This is the recommended way of obtaining \whizard. You may download
	the current stable distribution from the \whizard\ webpage,
	hosted at the HepForge webpage
	\begin{quote}
	\hepforgepage
	\end{quote}
	The distribution is a single file, say \ttt{whizard-\thisversion.tgz} for
	version \thisversion.

	You need the additional prerequisites:
	\begin{itemize}
	\item
	GNU \ttt{tar} (or \ttt{gunzip} and \ttt{tar}) for unpacking the
	tarball.
	\item
	The \ttt{make} utility. Other standard Unix utilities (\ttt{sed},
	\ttt{grep}, etc.) are usually installed by default.
	\item
	A modern \fortran\ compiler (see Sec.~\ref{sec:compilers} for
	details).
	\item
	The \ocaml\ system. \ocaml\ is a functional and object-oriented
	language. Version 4.02.3 or newer is required to compile all
	components of \whizard. The package is freely available either as a
	debian/RPM package on your system (it might be necessary to install
	it from the usual repositories), or you can obtain it directly from
	\begin{quote}
	\url{http://caml.inria.fr}
	\end{quote}
	and install it yourself. If desired, the package can be installed
	in user space without administrator privileges\footnote{
	Unfortunately, the version of the \ocaml\
	compiler from 3.12.0 broke backwards compatibility. Therefore,
	versions of \oMega/\whizard\ up to 2.0.2 only compile with older
	versions (3.11.x works). This has been fixed in versions
	2.0.3 and later. See also
	Sec.~\ref{sec:buildproblems}. \whizard\ versions up to 2.7.1 were
	still backwards compatible with \ocaml\ 3.12.0}.
	\end{itemize}
	The following optional external packages are not required, but used
	for certain purposes. Make sure to check whether you will need any of
	them, before you install \whizard.
	\begin{itemize}
	\item
	\LaTeX\ and \metapost\ for data visualization. Both are part of the
	\TeX\ program family. These programs are not absolutely necessary,
	but \whizard\ will lack the tools for visualization without them.
	\item
	The \lhapdf\ structure-function library. See
	Sec.~\ref{sec:lhapdf_install}.
	\item
	The \hoppet\ structure-function matching tool. See
	Sec.~\ref{sec:hoppet}.
	\item
	The \hepmc\ event-format package. See Sec.~\ref{sec:hepmc}.
	\item
	The \fastjet\ jet-algorithm package. See Sec.~\ref{sec:fastjet}.
	\item
	The \lcio\ event-format package. See Sec.~\ref{sec:lcio}.
	\end{itemize}
	Until version v2.2.7 of \whizard, the event-format package \stdhep\ used
	to be available as an external package. As their distribution is frozen
	with the final version v5.06.01, and it used to be notoriously difficult to
	compile and link \stdhep\ into \whizard, it was decided to include \stdhep\
	into \whizard. This is the case from version v2.2.8 of \whizard\ on. Linking
	against an external version of \stdhep\ is precluded from there
	on. Nevertheless, we list some explanations in Sec.~\ref{sec:stdhep},
	particularly on the need to install the \ttt{libtirpc} headers for the
	legacy support of this event format. Once these prerequisites are met,
	you may unpack the package in a directory of your choice
	\begin{quote}\small\tt
	some-directory> tar xzf whizard-\thisversion.tgz
	\end{quote}
	and proceed.\footnote{Without GNU \ttt{tar}, this would read
	\ttt{\small gunzip -c whizard-\thisversion.tgz \| tar xz -}}

	For using external physics models that are directly supported by
	\whizard\ and \oMega, the user can use tools like \sarah\ or
	\FeynRules. There installation and linking to \whizard\ will be
	explained in Chap.~\ref{chap:extmodels}. Besides this, also new models
	can be conveniently included via \UFO\ files, which will be explained
	as well in that chapter.

	The directory will then contain a subdirectory \ttt{whizard-\thisversion}
	where the complete source tree is located. To update later to a new
	version, repeat these steps. Each new version will unpack in a
	separate directory with the appropriate name.

	%%%%%

	\subsection{SVN Repository Version}

	If you want to install the latest development version, you have to
	check it out from the \whizard\ SVN repository. Note that since a
	couple of years our development is now via a Git revision control
	system hosted at the University of Siegen, cf. the next subsection.

	In addition to the prerequisites listed in the previous section, you
	need:
	\begin{itemize}
	\item
	The \ttt{subversion} package (\ttt{svn}), the tool for dealing with
	SVN repositories.
	\item
	The \ttt{autoconf} package, part of the \ttt{autotools} development
	system. \ttt{automake} is needed with version \ttt{1.12.2} or newer.
	\item
	The \ttt{noweb} package, a light-weight tool for literate programming. This
	package is nowadays often part of Linux distributions\footnote{In
	Ubuntu from version 10.04 on, and in Debian since
	squeeze. For \ttt{Mac OS X}, \ttt{noweb} is available via the
	\ttt{MacPorts} system.}. You can obtain the source code
	from\footnote{Please, do not use any of the binary builds from this
	webpage. Probably all of them are quite old and broken.}
	\begin{quote}
	\url{http://www.cs.tufts.edu/~nr/noweb/}
	\end{quote}
	\end{itemize}
	To start, go to a directory of your choice and execute
	\begin{interaction}
	your-src-directory> svn checkout
	svn+ssh://vcs@phab.hepforge.org/source/whizardsvn/trunk \;\; .
	\end{interaction}
	Note that for the time being after the HepForge system modernization
	early September 2018, a HepForge account with a local ssl key is
	necessary to checkout the subversion repository. This is enforced by
	the phabricator framework of HepForge, and will hopefully be relaxed
	in the future. The SVN source tree will appear in the current
	directory. To update later, you just have to execute
	\begin{interaction}
	your-src-directory> svn update
	\end{interaction}
	within that directory.

	After checking out the sources, you first have to create
	\ttt{configure.ac} by executing the shell script
	\ttt{build\_master.sh}. In order to build the \ttt{configure}
	script, the \ttt{autotools} package \ttt{autoreconf} has to be run. On
	some \ttt{Unix} systems the \ttt{RPC} headers needed for the legacy
	support of the \stdhep\ event format are provided by the \ttt{TIRPC}
	library (cf. Sec.~\ref{sec:stdhep}). To easily check for them,
	\ttt{configure.ac} processed by \ttt{autoreconf} makes use of the
	\ttt{pkg-config} tool which needs to be installed for the developer
	version. So now, run\footnote{At least, version
	2.65 of the \ttt{autoconf} package is required.}
	\begin{interaction}
	your-src-directory> autoreconf
	\end{interaction}
	This will generate a \ttt{configure} script.

	%%%%%

	\subsection{Public Git Repository Version}

	Since a couple of years, development of \whizard\ is done by means of
	a Git revision system, hosted at the University of Siegen. There is a
	public mirror of that Git repository available at
	\begin{quote}
	\url{https://gitlab.tp.nt.uni-siegen.de/whizard/public}
	\end{quote}
	Cloning via HTTPS brings the user to the same change as the SVN
	checkout from HepForge described in the previous subsection:
	\begin{quote}
	git clone https://gitlab.tp.nt.uni-siegen.de/whizard/public.git
	\end{quote}
	The next steps are the same as described in the previous subsection.

	%%%%%

	\subsection{Nightly development snapshots}

	Nightly development snapshots that are pre-packaged in the same way
	as an official distribution are available from
	\begin{quote}
	\url{https://whizard.tp.nt.uni-siegen.de/}
	\end{quote}
	Building \whizard\ works the way as described in
	Sec.~\ref{sec:tarballdistr}.


	%%%%%

	\subsection{\label{sec:compilers}Fortran Compilers}

	\whizard\ is written in modern \fortran. To be precise, it uses a
	subset of the \fortranOThree\ standard. At the time of this writing,
	this subset is supported by, at least, the following compilers:
	\begin{itemize}
	\item
	\ttt{gfortran} (GNU, Open Source). You will need version 9.5.0
	or higher\footnote{Note that \whizard\ versions 2.0.0 until 2.3.1 compiled
	with \ttt{gfortran} 4.7.4, but the object-oriented
	refactoring of the \whizard\ code from 2.4.0 on until version 2.6.5
	made a switch to \ttt{gfortran} 4.8.4 or higher necessary. In the
	same way, since version 2.7.0, \ttt{gfortran} 5.1.0 or newer is
	needed}. We recommend to use at least version 5.4 or higher, as
	especially the the early version of the \texttt{gfortran} experience
	some bugs. \ttt{gfortran} 6.5.0 has a severe regression and cannot
	be used. Before \whizard\ version 3.1.3, \ttt{gfortran} 7 and 8
	could be used.
	\item
	\ttt{nagfor} (NAG). You will need version 7.1 or higher.
	\item
	\ttt{ifort} (Intel). You will need version 21.3 or
	higher
	\end{itemize}

	%%%%%

	\subsection{LHAPDF}
	\label{sec:lhapdf_install}

	For computing scattering processes at hadron colliders such as the
	LHC, \whizard\ has a small set of standard structure-function
	parameterizations built in, cf.\ Sec.~\ref{sec:built-in-pdf}. For
	many applications, this will be sufficient, and you can skip this
	section.

	However, if you need structure-function parameterizations that are not
	in the default set (e.g. PDF error sets), you can use the \lhapdf\
	structure-function library, which is an external package. It has to
	be linked during \whizard\ installation. For use with \whizard,
	version 5.3.0 or higher of the library is required\footnote{ Note that
	PDF sets which contain photons as partons are only supported with
	\whizard\ for \lhapdf\ version 5.7.1 or higher}. The \lhapdf\
	package has undergone a major rewriting from \fortran\ version 5
	to \cpp\ version 6. While still maintaining the interface for
	the \lhapdf\ version 5 series, from version 2.2.2 of \whizard\ on, the
	new release series of \lhapdf, version 6.0 and higher, is also
	supported.

	If \lhapdf\ is not yet installed on your system, you can download it from
	\begin{quote}
	\url{https://lhapdf.hepforge.org}
	\end{quote}
	for the most recent LHAPDF version 6 and newer, or
	\begin{quote}
	\url{https://lhapdf.hepforge.org/lhapdf5}
	\end{quote}
	for version 5 and older, and install it. The website contains
	comprehensive documentation on the configuring and installation
	procedure. Make sure that you have downloaded and installed not just
	the package, but also the data sets. Note that \lhapdf\ version 5
	needs both a \fortran\ and a \cpp\ compiler.

	During \whizard\ configuration, \whizard\ looks for the script
	\ttt{lhapdf} (which is present in \lhapdf\ series 6) first, and then
	for \ttt{lhapdf-config} (which is present since \lhapdf\ version
	4.1.0): if those are in an executable path (or only
	the latter for \lhapdf\ version 5), the environment variables for
	\lhapdf\ are automatically recognized by \whizard, as well as the
	version number. This should look like this in the \ttt{configure}
	output (for \lhapdf\ version 6 or newer),

	\begin{footnotesize}
	\begin{verbatim}
	configure: --------------------------------------------------------------
	configure: --- LHAPDF ---
	configure:
	checking for lhapdf... /usr/local/bin/lhapdf
	checking for lhapdf-config... /usr/local/bin/lhapdf-config
	checking the LHAPDF version... 6.2.1
	checking the major version... 6
	checking the LHAPDF pdfsets path... /usr/local/share/LHAPDF
	checking the standard PDF sets... all standard PDF sets installed
	checking if LHAPDF is functional... yes
	checking LHAPDF... yes
	configure: --------------------------------------------------------------
	\end{verbatim}
	\end{footnotesize}
	while for \lhapdf\ version 5 and older it looks like this:

	\begin{footnotesize}
	\begin{verbatim}
	configure: --------------------------------------------------------------
	configure: --- LHAPDF ---
	configure:
	checking for lhapdf... no
	checking for lhapdf-config... /usr/local/bin/lhapdf-config
	checking the LHAPDF version... 5.9.1
	checking the major version... 5
	checking the LHAPDF pdfsets path... /usr/local/share/lhapdf/PDFsets
	checking the standard PDF sets... all standard PDF sets installed
	checking for getxminm in -lLHAPDF... yes
	checking for has_photon in -lLHAPDF... yes
	configure: --------------------------------------------------------------
	\end{verbatim}
	\end{footnotesize}

	If you want to use a different \lhapdf\ (e.g. because the one installed
	on your system by default is an older one), the preferred way to do so
	is to put the \ttt{lhapdf} (and/or \ttt{lhapdf-config}) scripts in an
	executable path that is checked before the system paths,
	e.g. \ttt{<home>/bin}.

	For the old series, \lhapdf\ version 5, a possible error could arise
	if \lhapdf\ had been compiled with a different \fortran\ compiler than
	\whizard, and if the run-time library of that \fortran\ compiler had
	not been included in the \whizard\ configure process. The output then
	looks like this:

	\begin{footnotesize}
	\begin{verbatim}
	configure: --------------------------------------------------------------
	configure: --- LHAPDF ---
	configure:
	checking for lhapdf... no
	checking for lhapdf-config... /usr/local/bin/lhapdf-config
	checking the LHAPDF version... 5.9.1
	checking the major version... 5
	checking the LHAPDF pdfsets path... /usr/local/share/lhapdf/PDFsets
	checking for standard PDF sets... all standard PDF sets installed
	checking for getxminm in -lLHAPDF... no
	checking for has_photon in -lLHAPDF... no
	configure: --------------------------------------------------------------
	\end{verbatim}
	\end{footnotesize}

	So, the \whizard\ configure found the \lhapdf\ distribution, but could
	not link because it could not resolve the symbols inside the
	library. In case of failure, for more details confer the
	\ttt{config.log}.

	If \lhapdf\ is installed in a non-default directory where
	\whizard\ would not find it, set the environment variable
	\ttt{LHAPDF\_DIR} to the correct installation path when configuring
	\whizard.

	The check for the standard PDF sets are those sets that are used in
	the default \whizard\ self tests in the case \lhapdf\ is enabled and
	correctly linked. If some of them are missing, then this test will
	result in a failure. They are the \ttt{CT10} set for \lhapdf\ version
	6 (for version 5, \ttt{cteq61.LHpdf}, \ttt{cteq6ll.LHpdf},
	\ttt{cteq5l.LHgrid}, and \ttt{GSG961.LHgrid} are demanded). If you
	want to use \lhapdf\ inside \whizard\ please install them such that
	\whizard\ could perform all its sanity checks with them. The last
	check is for the \ttt{has\_photon} flag, which tests whether photon
	PDFs are available in the found \lhapdf\ installation.

	%%%%%

	\subsection{HOPPET}
	\label{sec:hoppet}

	\hoppet\ (not Hobbit) is a tool for the QCD DGLAP evolution of PDFs
	for hadron colliders. It provides possibilities for matching
	algorithms for 4- and 5-flavor schemes, that are important for
	precision simulations of $b$-parton initiated processes at hadron
	colliders. If you are not interested in those features, you can skip
	this section. Note that this feature is not enabled by default (unlike
	e.g. \lhapdf), but has to be explicitly during the configuration
	(see below):
	\begin{interaction}
	your-build-directory> your-src-directory/configure --enable-hoppet
	\end{interaction}
	If you \ttt{configure} messages like the following:
	\begin{footnotesize}
	\begin{verbatim}
	configure: --------------------------------------------------------------
	configure: --- HOPPET ---
	configure:
	checking for hoppet-config... /usr/local/bin/hoppet-config
	checking for hoppetAssign in -lhoppet_v1... yes
	checking the HOPPET version... 1.2.0
	configure: --------------------------------------------------------------
	\end{verbatim}
	\end{footnotesize}
	then you know that \hoppet\ has been found and was correctly
	linked. If that is not the case, you have to specify the location of
	the \hoppet\ library, e.g. by adding
	\begin{interaction}
	HOPPET=<hoppet\_directory>/lib
	\end{interaction}
	to the \ttt{configure} options above. For more details, please confer
	the \hoppet\ manual.

	%%%%%

	\subsection{HepMC}
	\label{sec:hepmc}

	With version 2.8.1, \whizard\ supports both the "classical" version 2
	as well as the newly designed version 3 (release 2019). The configure
	step can successfully recognize the two different versions, the user
	do not have to specify which version is installed.

	\hepmc\ is a \cpp\ class library for handling collider scattering
	events. In particular, it provides a portable format for event files.
	If you want to use this format, you should link \whizard\ with \hepmc,
	otherwise you can skip this section.

	If it is not already installed on your system, you may obtain
	\hepmc\ from one of these two webpages:
	\begin{quote}
	\url{http://hepmc.web.cern.ch/hepmc/}
	\end{quote}
	or
	\begin{quote}
	\url{http://hepmc.web.cern.ch/hepmc/}
	\end{quote}
	If the \hepmc\ library is linked with the installation, \whizard\ is
	able to read and write files in the \hepmc\ format.

	Detailed information on the installation and usage can be found on the
	\hepmc\ homepage. We give here only some brief details relevant for
	the usage with \whizard: For the compilation of HepMC one needs a
	\cpp\ compiler. Then the procedure is the same as for the
	\whizard\ package, namely configure HepMC:
	\begin{interaction}
	configure --with-momentum=GEV --with-length=MM --prefix=<install dir>
	\end{interaction}
	Note that the particle momentum and decay length flags are mandatory, and
	we highly recommend to set them to the values \ttt{GEV} and \ttt{MM},
	respectively. After configuration, do \ttt{make}, an optional
	\ttt{make check} (which might sometimes fail for non-standard values
	of momentum and length), and finally \ttt{make install}.

	The latest version of \hepmc\ (2.6.10) as well as the new relase
	series use \texttt{cmake} for their build process. For more
	information, confer the \hepmc\ webpage.

	A \whizard\ configuration for \hepmc\ looks like this:
	\begin{footnotesize}
	\begin{verbatim}
	configure: --------------------------------------------------------------
	configure: --- HepMC ---
	configure:
	checking for HepMC-config... no
	checking HepMC3 or newer... no
	configure: HepMC3 not found, incompatible, or HepMC-config not found
	configure: looking for HepMC2 instead ...
	checking the HepMC version... 2.06.10
	checking for GenEvent class in -lHepMC... yes
	configure: --------------------------------------------------------------
	\end{verbatim}
	\end{footnotesize}

	If \hepmc\ is installed in a non-default directory where \whizard\
	would not find it, set the environment variable \ttt{HEPMC\_DIR} to
	the correct installation path when configuring \whizard. Furthermore,
	the environment variable \ttt{CXXFLAGS} allows you to set specific
	\ttt{C/C++} preprocessor flags, e.g. non-standard include paths for
	header files.

	A typical configuration of \hepmcthree\ will look like this:
	\begin{footnotesize}
	\begin{verbatim}
	configure: --------------------------------------------------------------
	configure: --- ROOT ---
	configure:
	checking for root-config... /usr/local/bin/root-config
	checking for root... /usr/local/bin/root
	checking for rootcint... /usr/local/bin/rootcint
	checking for dlopen in -ldl... (cached) yes
	configure: --------------------------------------------------------------
	configure: --- HepMC ---
	configure:
	checking for HepMC3-config... /usr/local/bin/HepMC3-config
	checking if HepMC3 is built with ROOT interface... yes
	checking if HepMC3 is functional... yes
	checking for HepMC3... yes
	checking the HepMC3 version... 3.02.01
	configure: --------------------------------------------------------------
	\end{verbatim}
	\end{footnotesize}
	As can be seen, \whizard\ will check for the \ROOT\ environment as
	well as whether \hepmcthree\ has been built with support for the
	\ROOT\ and \ttt{RootTree} writer classes. This is an easy option to
	use \whizard\ to write out \ROOT\ events. For more information see
	Sec.~\ref{sec:root}.

	%%%%%

	\subsection{PYTHIA6}
	\label{sec:pythia6_conf}

	The \whizard\ package ships with the final version of the old
	\pythiasix\ release series, v6.427. This is no longer maintained, but
	many analyses are still set up for this shower and hadronization tool,
	so \whizard\ offers the possibility of backwards compatibility here.
	\begin{quote}
	configure: --------------------------------------------------------------
	configure: --- SHOWERS PYTHIA6 PYTHIA8 MPI ---
	configure:
	checking whether we want to enable PYTHIA6... yes
	checking for PYTHIA6... (enabled)
	checking for PYTHIA6 eh settings... (disabled)
	\end{quote}
	\whizard\ automatically compiles \pythiasix, it has not to be
	specifically enabled by the user.

	In order to properly use \pythiasix\ for high-energy electron-hadron
	collisions which allow much further forward regions to be explored as
	old experiments like HERA, there is a special switch to enable those
	specific settings for $eh$-colliders:
	\begin{quote}
	\ttt{--enable-pythia6\_ep}
	\end{quote}
	Those settings have been provided by~\cite{UtaKlein}.

	%%%%%

	\subsection{PYTHIA8}
	\label{sec:pythia8}

	\pythiaeight\ is a \cpp\ class library for handling hadronization,
	showering and underlying event. If you want to use this feature (once it is
	fully supported in \whizard), you should link \whizard\ with \pythiaeight,
	otherwise you can skip this section.

	If it is not already installed on your system, you may obtain
	\pythiaeight\ from
	\begin{quote}
	\url{http://home.thep.lu.se/~torbjorn/Pythia.html}
	\end{quote}
	If the \pythiaeight\ library is linked with the installation, \whizard\ will
	be able to use its hadronization and showering, once this is fully supported
	within \whizard.

	To link a \pythiaeight\ installation to \whizard, you should specify the flag
	\begin{quote}
	\ttt{--enable-pythia8}
	\end{quote}
	to \ttt{configure}. If \pythiaeight\ is installed in a non-default directory
	where \whizard\ would not find it, specify also
	\begin{quote}
	\ttt{--with-pythia8=\emph{<your-pythia8-installation-path>}}
	\end{quote}

	A successful \whizard\ configuration should produce a screen output
	similar to this:
	\begin{footnotesize}
	\begin{verbatim}
	configure: --------------------------------------------------------------
	configure: --- SHOWERS PYTHIA6 PYTHIA8 MPI ---
	configure:
	[....]
	checking for pythia8-config... /usr/local/bin/pythia8-config
	checking if PYTHIA8 is functional... yes
	checking PYTHIA8... yes
	configure: WARNING: PYTHIA8 configure is for testing purposes at the moment.
	configure: --------------------------------------------------------------
	\end{verbatim}
	\end{footnotesize}

	%%%%%

	\subsection{FastJet}
	\label{sec:fastjet}

	\fastjet\ is a \cpp\ class library for handling jet clustering.
	If you want to use this feature, you should link \whizard\ with \fastjet,
	otherwise you can skip this section.

	If it is not already installed on your system, you may obtain
	\fastjet\ from
	\begin{quote}
	\url{http://fastjet.fr}
	\end{quote}
	If the \fastjet\ library is linked with the installation, \whizard\ is
	able to call the jet algorithms provided by this program for the purposes of
	applying cuts and analysis.

	To link a \fastjet\ installation to \whizard, you should specify the flag
	\begin{quote}
	\ttt{--enable-fastjet}
	\end{quote}
	to \ttt{configure}. If \fastjet\ is installed in a non-default directory
	where \whizard\ would not find it, specify also
	\begin{quote}
	\ttt{--with-fastjet=\emph{<your-fastjet-installation-path>}}
	\end{quote}

	A successful \whizard\ configuration should produce a screen output
	similar to this:
	\begin{footnotesize}
	\begin{verbatim}
	configure: --------------------------------------------------------------
	configure: --- FASTJET ---
	configure:
	checking for fastjet-config... /usr/local/bin/fastjet-config
	checking if FastJet is functional... yes
	checking FastJet... yes
	checking the FastJet version... 3.3.4
	configure: --------------------------------------------------------------
	\end{verbatim}
	\end{footnotesize}

	Note that when compiling on Darwin/macOS it might be necessary to
	set the option \ttt{--disable-auto-ptr} when compiling with
	\ttt{clang++}.

	%%%%%

	\subsection{STDHEP}
	\label{sec:stdhep}

	\stdhep\ is a library for handling collider scattering
	events~\cite{stdhep}. In particular, it provides a portable format
	for event files. Until version 2.2.7 of \whizard, \stdhep\ that was
	maintained by Fermilab, could be linked as an externally compiled
	library. As the \stdhep\ package is frozen in its final release
	v5.06.1 and no longer maintained, it has from version 2.2.8 been
	included \whizard. This eases many things, as it was notoriously
	difficult to compile and link \stdhep\ in a way compatible with
	\whizard. Not the full package has been included, but only the
	libraries for file I/O (\ttt{mcfio}, the library for the XDR
	conversion), while the various translation tools for \pythia, \herwig,
	etc. have been abandoned. Note that \stdhep\ has largely been
	replaced in the hadron collider community by the \hepmc\ format, and
	in the lepton collider community by \lcio. \whizard\ might serve as a
	conversion tools for all these formats, but other tools also exist, of
	course. Note that the \ttt{mcfio} framework makes use of the \ttt{RPC}
	headers. These come -- provided by \ttt{SunOS/Oracle America, Inc.} --
	together with the system headers, but on some \ttt{Unix} systems
	(e.g. \ttt{ArchLinux}, \ttt{Fedora}) have been replaced by the
	\ttt{libtirpc} headers . The \ttt{configure} script searches for these
	headers so these have to be installed mandatorily.

	If the \stdhep\ library is linked with the installation, \whizard\ is
	able to write files in the \stdhep\ format, the corresponding
	configure output notifies you that \stdhep\ is always included:
	\begin{footnotesize}
	\begin{verbatim}
	configure: --------------------------------------------------------------
	configure: --- STDHEP ---
	configure:
	checking for pkg-config... /opt/local/bin/pkg-config
	checking pkg-config is at least version 0.9.0... yes
	checking for libtirpc... no
	configure: for StdHEP legacy code: using SunRPC headers and library
	configure: StdHEP v5.06.01 is included internally
	configure: --------------------------------------------------------------
	\end{verbatim}
	\end{footnotesize}

	%%%%%

	\subsection{LCIO}
	\label{sec:lcio}


	\lcio\ is a \cpp\ class library for handling collider scattering
	events. In particular, it provides a portable format for event files.
	If you want to use this format, you should link \whizard\ with \lcio,
	otherwise you can skip this section.

	If it is not already installed on your system, you may obtain
	\lcio\ from:
	\begin{quote}
	\url{http://lcio.desy.de}
	\end{quote}
	If the \lcio\ library is linked with the installation, \whizard\ is
	able to read and write files in the \lcio\ format.

	Detailed information on the installation and usage can be found on the
	\lcio\ homepage. We give here only some brief details relevant for
	the usage with \whizard: For the compilation of \lcio\ one needs a
	\cpp\ compiler. \lcio\ is based on \ttt{cmake}. For the
	corresponding options please confer the \lcio\ manual.

	A \whizard\ configuration for \lcio\ looks like this:
	\begin{footnotesize}
	\begin{verbatim}
	configure: --------------------------------------------------------------
	configure: --- LCIO ---
	configure:
	checking the LCIO version... 2.12.1
	checking for LCEventImpl class in -llcio... yes
	configure: --------------------------------------------------------------
	\end{verbatim}
	\end{footnotesize}

	If \lcio\ is installed in a non-default directory where \whizard\
	would not find it, set the environment variable \ttt{LCIO} or
	\ttt{LCIO\_DIR} to the correct installation path when configuring
	\whizard. The first one is the variable exported by the
	\ttt{setup.sh} script while the second one is analogous to the
	environment variables of other external packages. \ttt{LCIO} takes
	precedence over \ttt{LCIO\_DIR}. Furthermore, the environment variable
	\ttt{CXXFLAGS} allows you to set specific \ttt{C/C++} preprocessor
	flags, e.g. non-standard include paths for header files.

	%%%%%

	\section{Installation}
	\label{sec:installation}

	Once you have unpacked the source (either the tarball or the SVN
	version), you are ready to compile it. There are several options.


	\subsection{Central Installation}
	This is the default and recommended way, but it requires adminstrator
	privileges. Make sure that all
	prerequisites are met (Sec.~\ref{sec:prerequisites}).
	\begin{enumerate}
	\item
	Create a fresh directory for the \whizard\ build. It is recommended
	to keep this separate from the source directory.
	\item
	Go to that directory and execute
	\begin{interaction}
	your-build-directory> your-src-directory/configure
	\end{interaction}
	This will analyze your system and prepare the compilation of \whizard\
	in the build directory. Make sure to set the proper options to
	\ttt{configure}, see Sec.~\ref{sec:configure-options} below.
	\item
	Call \ttt{make} to compile and link \whizard:
	\begin{interaction}
	your-build-directory> make
	\end{interaction}
	\item
	If you want to make sure that everything works, run
	\begin{interaction}
	your-build-directory> make check
	\end{interaction}
	This will take some more time.
	\item
	Become superuser and say
	\begin{interaction}
	your-build-directory> make install
	\end{interaction}
	\end{enumerate}
	\whizard\ should now installed in the default locations, and the
	executable should be available in the standard path. Try to call
	\ttt{whizard --help} in order to check this.

	\subsection{Installation in User Space}
	You may lack administrator privileges on your system. In that case,
	you can still install and run \whizard. Make sure that all
	prerequisites are met (Sec.~\ref{sec:prerequisites}).
	\begin{enumerate}
	\item
	Create a fresh directory for the \whizard\ build. It is recommended
	to keep this separate from the source directory.
	\item
	Reserve a directory in user space for the \whizard\ installation.
	It should be empty, or yet non-existent.
	\item
	Go to that directory and execute
	\begin{interaction}
	your-build-directory> your-src-directory/configure
	--prefix=your-install-directory
	\end{interaction}
	This will analyze your system and prepare the compilation of \whizard\
	in the build directory. Make sure to set the proper additional options to
	\ttt{configure}, see Sec.~\ref{sec:configure-options} below.
	\item
	Call \ttt{make} to compile and link \whizard:
	\begin{interaction}
	your-build-directory> make
	\end{interaction}
	\item
	If you want to make sure that everything works, run
	\begin{interaction}
	your-build-directory> make check
	\end{interaction}
	This will take some more time.
	\item
	Install:
	\begin{interaction}
	your-build-directory> make install
	\end{interaction}
	\end{enumerate}
	\whizard\ should now be installed in the installation directory of your
	choice. If the installation is not in your standard search paths, you
	have to account for this by extending the paths appropriately, see
	Sec.~\ref{sec:workspace}.


	\subsection{Configure Options}
	\label{sec:configure-options}

	The configure script accepts environment variables and flags. They
	can be given as arguments to the \ttt{configure} program in arbitrary
	order. You may run \ttt{configure --help} for a listing; only the
	last part of this long listing is specific for the \whizard\ system.
	Here is an example:
	\begin{interaction}
	configure FC=gfortran FCFLAGS="-g -O3" --enable-fc-openmp
	\end{interaction}

	The most important options are
	\begin{itemize}
	\item
	\ttt{FC} (variable): The \fortran\ compiler. This is necessary if
	you need a compiler different from the standard compiler on the
	system, e.g., if the latter is too old.
	\item
	\ttt{FCFLAGS} (variable): The flags to be given to the \fortran\
	compiler. The main use is to control the level of optimization.
	\item
	\ttt{--prefix=\var{directory-name}}: Specify a non-default directory
	for installation.
	\item
	\ttt{--enable-fc-openmp}: Enable parallel executing via OpenMP on a
	multi-processor/multi-core machine. This works only if OpenMP is
	supported by the compiler (e.g., \ttt{gfortran}). When running
	\whizard, the number of processors that are actually requested can
	be controlled by the user. Without this option, \whizard\ will run
	in serial mode on a single core. See Sec.~\ref{sec:openmp} for
	further details.
	\item
	\ttt{--enable-fc-mpi}: Enable parallel executing via MPI on a single
	machine using several cores or several machines. This works only if a MPI
	library is installed (e.g. \ttt{OpenMPI}) and \ttt{FC=mpifort CC=mpicc CXX=mpic++} is
	set. Without this option, \whizard\ will run in serial mode on a single core.
	The flag can be combined with \ttt{--enable-fc-openmp}. See Sec.~\ref{sec:mpi}
	for further details.
	\item
	\ttt{LHADPF\_DIR} (variable): The location of the optional \lhapdf\
	package, if non-default.
	\item
	\ttt{LOOPTOOLS\_DIR} (variable): The location of the optional \ttt{LOOPTOOLS}
	package, if non-default.
	\item
	\ttt{OPENLOOPS\_DIR} (variable): The location of the optional \openloops\
	package, if non-default.
	\item
	\ttt{GOSAM\_DIR} (variable): The location of the optional \gosam\
	package, if non-default.
	\item
	\ttt{HOPPET\_DIR} (variable): The location of the optional \hoppet\
	package, if non-default.
	\item
	\ttt{HEPMC\_DIR} (variable): The location of the optional \hepmc\ package, if
	non-default.
	\item
	\ttt{LCIO}/\ttt{LCIO\_DIR} (variable): The location of the optional
	\lcio\ package, if non-default.
	\end{itemize}

	Other flags that might help to work around possible problems are the
	flags for the $C$ and \cpp\ compilers as well as the \ttt{Fortran77}
	compiler, or the linker flags and additional libraries for the linking
	process.
	\begin{itemize}
	\item
	\ttt{CC} (variable): \ttt{C} compiler command
	\item
	\ttt{F77} (variable): \ttt{Fortran77} compiler command
	\item
	\ttt{CXX} (variable): \ttt{C++} compiler command
	\item
	\ttt{CPP} (variable): \ttt{C} preprocessor
	\item
	\ttt{CXXCPP} (variable): \ttt{C++} preprocessor
	\item
	\ttt{CFLAGS} (variable): \ttt{C} compiler flags
	\item
	\ttt{FFLAGS} (variable): \ttt{Fortran77} compiler flags
	\item
	\ttt{CXXFLAGS} (variable): \ttt{C++} compiler flags
	\item
	\ttt{LIBS} (variable): libraries to be passed to the linker as
	\ttt{-l{\em library}}
	\item
	\ttt{LDFLAGS} (variable): non-standard linker flags
	\end{itemize}

	For other options (like e.g. \ttt{--with-precision=...} etc.) please
	see the \ttt{configure --help} option.

	%%%%%

	\subsection{Details on the Configure Process}

	The configure process checks for the build and host system type; only
	if this is not detected automatically, the user would have to specify
	this by himself. After that system-dependent files are searched for,
	LaTeX and Acroread for documentation and plots, the \fortran\ compiler
	is checked, and finally the \ocaml\ compiler. The next step is the
	checks for external programs like \lhapdf\ and \ttt{HepMC}.
	Finally, all the Makefiles are being built.

	The compilation is done by invoking \ttt{make} and finally
	\ttt{make install}. You could also do a \ttt{make check} in
	order to test whether the compilation has produced sane files on your
	system. This is highly recommended.

	Be aware that there be problems for the installation if the install
	path or a user's home directory is part of an AFS file system. Several
	times problems were encountered connected with conflicts with
	permissions inside the OS permission environment variables and the AFS
	permission flags which triggered errors during the \ttt{make install}
	procedure. Also please avoid using \ttt{make -j} options of parallel
	execution of \ttt{Makefile} directives as AFS filesystems might not be
	fast enough to cope with this.

	For specific problems that might have been encountered in rare
	circumstances for some FORTRAN compilers confer the webpage
	\url{https://whizard.hepforge.org/compilers.html}.

	Note that the \pythia\ bundle for showering and hadronization (and
	some other external legacy code pieces) do still contain good old
	\ttt{Fortran77} code. These parts should better be
	compiled with the very same \ttt{Fortran2003} compiler as the
	\whizard\ core. There is, however, one subtlety:
	when the \ttt{configure} flag \ttt{FC} gets a full system path as
	argument, \ttt{libtool} is not able to recognize this as a valid (GNU)
	\ttt{Fortran77} compiler. It then searches automatically for binaries
	like \ttt{f77}, \ttt{g77} etc. or a standard system compiler. This
	might result in a compilation failure of the \ttt{Fortran77} code. A
	viable solution is to define an executable link and use this (not the
	full path!) as \ttt{FC} flag.

	It is possible to compile \whizard\ without the \ocaml\ parts of
	\oMega, namely by using the \ttt{--disable-omega} option of the
	configure. This will result in a built of \whizard\ with the \oMega\
	\fortran\ library, but without the binaries for the matrix element
	generation. All selftests (cf. \ref{sec:selftests}) requiring \oMega\
	matrix elements are thereby switched off. Note that you can install
	such a built (e.g. on a batch system without \ocaml\ installation), but
	the try to build a distribution (all \ttt{make distxxx} targets) will fail.

	%%%%%%%%%%%

	\subsection{Building on Darwin/macOS}

	The easiest way to build \whizard\ on Darwin/macOS is to install the
	complete GNU compiler suite (\ttt{gcc/g++/gfortran}). This can be done
	with one of the code repositories like \ttt{MacPorts}, \ttt{HomeBrew}
	or \ttt{Fink}. In order to include \ROOT\ which natively should be
	built using the intrinsic \ttt{clang/clang++} for the graphics
	support, there is also the possibility to build external tools like
	\hepmcthree, \pythiaeight, \fastjet, and \lcio\ with \ttt{clang++},
	and set in the configure option for \whizard\ \ttt{C} and \ttt{C++}
	compiler accordingly:
	\begin{quote}
	../configure CC=clang CXX=clang++ [...]
	\end{quote}
	Note that \fastjet\ might need to be configured with the
	\ttt{--disable-auto-ptr} option when compiling with \ttt{clang++}
	and strict \ttt{C++17} standard.

	Since Darwin v10.11, the security measures of the new Darwin systems
	do not allow e.g. environment variables passed to subprocesses. This
	does not change anything for the installed WHIZARD, but the testsuite
	(make check) will not work before make install has been executed. make
	distcheck will not work on El Capitan. There is also the option to
	disable the System Integrity Protocol (SIP) of modern OSX by booting
	in Recovery Mode, open a terminal and type \ttt{csrutil
	disable}. However, we do not recommend to do so.

	%%%%%%%%%%%

	\subsection{Building on Windows}

	For Windows, from \ttt{Windows 10} onwards, there is the possibility
	to install and use an underlying Linux operating system,
	e.g. \ttt{Ubuntu}. Installation and usage of \whizard\ works then the
	same way as described above.

	%%%%%%%%%%%


	\subsection{\whizard\ self tests/checks}
	\label{sec:selftests}

	\whizard\ has a number of self-consistency checks and tests which assure
	that most of its features are running in the intended way. The
	standard procedure to invoke these self tests is to perform a
	\ttt{make check} from the \ttt{build} directory. If \ttt{src}
	and \ttt{build} directories are the same, all relevant files for
	these self-tests reside in the \ttt{tests} subdirectory of the main
	\whizard\ directory. In that case, one could in principle just call the
	scripts individually from the command line. Note, that if \ttt{src}
	and \ttt{build} directory are different as recommended, then the
	input files will have been installed in
	\ttt{prefix/share/whizard/test}, while the corresponding test shell
	scripts remain in the \ttt{srcdir/test} directory. As the main shell
	script \ttt{run\_whizard.sh} has been built in the \ttt{build}
	directory, one now has to copy the files over by and set the correct
	paths by hand, if one wishes to run the test scripts individually.
	\ttt{make check} still correctly performs all \whizard\
	self-consistency tests. The tests itself fall into two categories,
	unit self test that individually test the modular structure of
	\whizard, and tests that are run by \sindarin\ files. In future releases
	of \whizard, these two categories of tests will be better separated
	than in the 2.2.1 release.

	There are additional, quite extensiv numerical tests for validation
	and backwards compatibility checks for SM and MSSM processes. As a
	standard, these extended self tests are not invoked. However, they can
	be enabled by executing the corresponding specific \ttt{make check}
	operations in the subdirectories for these extensive tests.

	As the new \whizard\ testsuite does very thorough and scrupulous tests
	of the whole \whizard\ structure, it is always possible that some
	tests are failing due to some weird circumstances or because of
	numerical fluctuations. In such a case do not panic, contact the
	developers (\ttt{whizard@desy.de}) and provide them with the logfiles
	of the failing test as well as the setup of your configuration.


	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\clearpage

	\chapter{Working with \whizard}
	\label{chap:start}

	\whizard\ can run as a stand-alone program. You (the user) can steer
	\whizard\ either interactively or by a script file. We will first
	describe the latter method, since it will be the most common way to
	interact with the \whizard\ system.

	\section{Hello World}

	The legacy version series 1 of the program relied on a bunch of input
	files that the user had to provide in some obfuscated format. This
	approach is sufficient for straightforward applications. However, once
	you get experienced with a program, you start thinking about uses that
	the program's authors did not foresee. In case of a Monte Carlo
	package, typical abuses are parameter scans, complex patterns of cuts
	and reweighting factors, or data analysis without recourse to external
	packages. This requires more flexibility.

	Instead of transferring control over data input to some generic
	scripting language like \ttt{PERL} or \python\ (or even \cpp), which
	come with their own peculiarities and learning curves, we decided to
	unify data input and scripting in a dedicated steering language that
	is particularly adapted to the needs of Monte-Carlo integration,
	simulation, and simple analysis of the results. Thus we discovered
	what everybody knew anyway: that W(h)izards communicate in \sindarin,
	Scripting INtegration, Data Analysis, Results display and INterfaces.

	\sindarin\ is a DSL -- a domain-specific scripting language -- that is
	designed for the single purpose of steering and talking to \whizard.
	Now since \sindarin\ is a programming language, we honor the old
	tradition of starting with the famous Hello World program. In
	\sindarin\ this reads simply
	\begin{quote}
	\begin{verbatim}
	printf "Hello World!"
	\end{verbatim}
	\end{quote}
	Open your favorite editor, type this text, and save it into a file
	named \verb\|hello.sin\|.

	\begin{figure}
	\centering
	\begin{scriptsize}
	\begin{Verbatim}[frame=single]
	\| Writing log to 'whizard.log'
	\|=============================================================================\|
	\| \|
	\| WW WW WW WW WW WWWWWW WW WWWWW WWWW \|
	\| WW WW WW WW WW WW WW WWWW WW WW WW WW \|
	\| WW WW WW WW WWWWWWW WW WW WW WW WWWWW WW WW \|
	\| WWWW WWWW WW WW WW WW WWWWWWWW WW WW WW WW \|
	\| WW WW WW WW WW WWWWWW WW WW WW WW WWWW \|
	\| \|
	\| \|
	\| W \|
	\| sW \|
	\| WW \|
	\| sWW \|
	\| WWW \|
	\| wWWW \|
	\| wWWWW \|
	\| WW WW \|
	\| WW WW \|
	\| wWW WW \|
	\| wWW WW \|
	\| WW WW \|
	\| WW WW \|
	\| WW WW \|
	\| WW WW \|
	\| WW WW \|
	\| WW WW \|
	\| wwwwww WW WW \|
	\| WWWWWww WW WW \|
	\| WWWWWwwwww WW WW \|
	\| wWWWwwwwwWW WW \|
	\| wWWWWWWWWWWwWWW WW \|
	\| wWWWWW wW WWWWWWW \|
	\| WWWW wW WW wWWWWWWWwww \|
	\| WWWW wWWWWWWWwwww \|
	\| WWWW WWWW WWw \|
	\| WWWWww WWWW \|
	\| WWWwwww WWWW \|
	\| wWWWWwww wWWWWW \|
	\| WwwwwwwwwWWW \|
	\| \|
	\| \|
	\| \|
	\| by: Wolfgang Kilian, Thorsten Ohl, Juergen Reuter \|
	\| with contributions from Christian Speckner \|
	\| Contact: <whizard@desy.de> \|
	\| \|
	\| if you use WHIZARD please cite: \|
	\| W. Kilian, T. Ohl, J. Reuter, Eur.Phys.J.C71 (2011) 1742 \|
	\| [arXiv: 0708.4233 [hep-ph]] \|
	\| M. Moretti, T. Ohl, J. Reuter, arXiv: hep-ph/0102195 \|
	\| \|
	\|=============================================================================\|
	\| WHIZARD 3.1.3
	\|=============================================================================\|
	\| Reading model file '/usr/local/share/whizard/models/SM.mdl'
	\| Preloaded model: SM
	\| Process library 'default_lib': initialized
	\| Preloaded library: default_lib
	\| Reading commands from file 'hello.sin'
	Hello World!
	\| WHIZARD run finished.
	\|=============================================================================\|
	\end{Verbatim}
	\end{scriptsize}
	\caption{Output of the \ttt{"Hello world!"} \sindarin\ script.\label{fig:helloworld}}
	\end{figure}

	Now we assume that you -- or your kind system administrator -- has
	installed \whizard\ in your executable path. Then you should open a
	command shell and execute (we will come to the meaning of the
	\verb\|-r\| option later.)
	\begin{verbatim}
	/home/user$ whizard -r hello.sin
	\end{verbatim}
	and if everything works well, you get the output (the complete output
	including the \whizard\ banner is shown in Fig.~\ref{fig:helloworld})
	\begin{footnotesize}
	\begin{verbatim}
	\| Writing log to 'whizard.log'
	\end{verbatim}
	\centerline{[... here a banner is displayed]}
	\begin{Verbatim}
	\|=============================================================================\|
	\| WHIZARD 3.1.3
	\|=============================================================================\|
	\| Reading model file '/usr/local/share/whizard/models/SM.mdl'
	\| Preloaded model: SM
	! Process library 'default_lib': initialized
	! Preloaded library: default_lib
	\| Reading commands from file 'hello.sin'
	Hello World!
	\| WHIZARD run finished.
	\|=============================================================================\|
	\end{Verbatim}
	\end{footnotesize}
	If this has just worked for you, you can be confident that you have a working
	\whizard\ installation, and you have been able to successfully run the
	program.

	\section{A Simple Calculation}
	You may object that \whizard\ is not exactly designed for printing out
	plain text. So let us demonstrate a more useful example.

	Looking at the Hello World output, we first observe that the program
	writes a log file named (by default) \verb\|whizard.log\|. This file
	receives all screen output, except for the output of external programs
	that are called by \whizard. You don't have to cache \whizard's screen
	output yourself.

	After the welcome banner, \whizard\ tells you that it reads a physics
	\emph{model}, and that it initializes and preloads a \emph{process library}. The
	process library is initially empty. It is ready for receiving
	definitions of elementary high-energy physics processes (scattering or
	decay) that you provide. The processes are set in the context of a
	definite model of high-energy physics. By default this is the
	Standard Model, dubbed \verb\|SM\|.

	Here is the \sindarin\ code for defining a SM physics process, computing
	its cross section, and generating a simulated event sample in Les Houches
	event format:
	\begin{quote}
	\begin{Verbatim}
	process ee = e1, E1 => e2, E2
	sqrts = 360 GeV
	n_events = 10
	sample_format = lhef
	simulate (ee)
	\end{Verbatim}
	\end{quote}
	As before, you save this text in a file (named, e.g.,
	\verb\|ee.sin\|) which is run by
	\begin{verbatim}
	/home/user$ whizard -r ee.sin
	\end{verbatim}
	(We will come to the meaning of the \verb\|-r\| option later.)
	This produces a lot of output which looks similar to this:

	\begin{footnotesize}
	\begin{verbatim}
	\| Writing log to 'whizard.log'
	[... banner ...]
	\|=============================================================================\|
	\| WHIZARD 3.1.3
	\|=============================================================================\|
	\| Reading model file '/usr/local/share/whizard/models/SM.mdl'
	\| Preloaded model: SM
	\| Process library 'default_lib': initialized
	\| Preloaded library: default_lib
	\| Reading commands from file 'ee.sin'
	\| Process library 'default_lib': recorded process 'ee'
	sqrts = 3.600000000000E+02
	n_events = 10
	\end{verbatim}

	\begin{verbatim}
	\| Starting simulation for process 'ee'
	\| Simulate: process 'ee' needs integration
	\| Integrate: current process library needs compilation
	\| Process library 'default_lib': compiling ...
	\| Process library 'default_lib': writing makefile
	\| Process library 'default_lib': removing old files
	rm -f default_lib.la
	rm -f default_lib.lo default_lib_driver.mod opr_ee_i1.mod ee_i1.lo
	rm -f ee_i1.f90
	\| Process library 'default_lib': writing driver
	\| Process library 'default_lib': creating source code
	rm -f ee_i1.f90
	rm -f opr_ee_i1.mod
	rm -f ee_i1.lo
	/usr/local/bin/omega_SM.opt -o ee_i1.f90 -target:whizard
	-target:parameter_module parameters_SM -target:module opr_ee_i1
	-target:md5sum '70DB728462039A6DC1564328E2F3C3A5' -fusion:progress
	-scatter 'e- e+ -> mu- mu+'
	[1/1] e- e+ -> mu- mu+ ... allowed. [time: 0.00 secs, total: 0.00 secs, remaining: 0.00 secs]
	all processes done. [total time: 0.00 secs]
	SUMMARY: 6 fusions, 2 propagators, 2 diagrams
	\| Process library 'default_lib': compiling sources
	[.....]
	\end{verbatim}


	\begin{verbatim}
	\| Process library 'default_lib': loading
	\| Process library 'default_lib': ... success.
	\| Integrate: compilation done
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 9616
	\| Initializing integration for process ee:
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'ee'
	\| Library name = 'default_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'ee_i1': e-, e+ => mu-, mu+ [omega]
	\| ------------------------------------------------------------------------
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e- (mass = 5.1099700E-04 GeV)
	\| e+ (mass = 5.1099700E-04 GeV)
	\| sqrts = 3.600000000000E+02 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'ee_i1.phs'
	\| Phase space: 2 channels, 2 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\end{verbatim}


	\begin{verbatim}
	\| Starting integration for process 'ee'
	\| Integrate: iterations not specified, using default
	\| Integrate: iterations = 3:1000:"gw", 3:10000:""
	\| Integrator: 2 chains, 2 channels, 2 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 1000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 784 8.3282892E+02 1.68E+00 0.20 0.06* 39.99
	2 784 8.3118961E+02 1.23E+00 0.15 0.04* 76.34
	3 784 8.3278951E+02 1.36E+00 0.16 0.05 54.45
	\|-----------------------------------------------------------------------------\|
	3 2352 8.3211789E+02 8.01E-01 0.10 0.05 54.45 0.50 3
	\|-----------------------------------------------------------------------------\|
	4 9936 8.3331732E+02 1.22E-01 0.01 0.01* 54.51
	5 9936 8.3341072E+02 1.24E-01 0.01 0.01 54.52
	6 9936 8.3331151E+02 1.23E-01 0.01 0.01* 54.51
	\|-----------------------------------------------------------------------------\|
	6 29808 8.3334611E+02 7.10E-02 0.01 0.01 54.51 0.20 3
	\|=============================================================================\|
	\end{verbatim}

	\begin{verbatim}
	[.....]
	\| Simulate: integration done
	\| Simulate: using integration grids from file 'ee_m1.vg'
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 9617
	\| Simulation: requested number of events = 10
	\| corr. to luminosity [fb-1] = 1.2000E-02
	\| Events: writing to LHEF file 'ee.lhe'
	\| Events: writing to raw file 'ee.evx'
	\| Events: generating 10 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: closing LHEF file 'ee.lhe'
	\| Events: closing raw file 'ee.evx'
	\| There were no errors and 1 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	\end{verbatim}
	\end{footnotesize}
	%$
	The final result is the desired event file, \ttt{ee.lhe}.

	Let us discuss the output quickly to walk you through the procedures
	of a \whizard\ run: after the logfile message and the banner, the
	reading of the physics model and the initialization of a process
	library, the recorded process with tag \ttt{'ee'} is recorded. Next,
	user-defined parameters like the center-of-mass energy and the number
	of demanded (unweighted) events are displayed. As a next step,
	\whizard\ is starting the simulation of the process with tag
	\ttt{'ee'}. It recognizes that there has not yet been an integration
	over phase space (done by an optional \ttt{integrate} command,
	cf. Sec.~\ref{sec:integrate}), and consequently starts the
	integration. It then acknowledges, that the process code for the
	process \ttt{'ee'} needs to be compiled first (done by an optional
	\ttt{compile} command, cf. Sec.~\ref{sec:compilation}). So, \whizard\
	compiles the process library, writes the makefile for its steering,
	and as a safeguard against garbage removes possibly existing
	files. Then, the source code for the library and its processes are
	generated: for the process code, the default method -- the matrix
	element generator \oMega\ is called (cf. Sec.~\ref{sec:omega_me}); and
	the sources are being compiled.

	The next steps are the loading of the process library, and \whizard\
	reports the completion of the integration. For the Monte-Carlo
	integration, a random number generator is initialized. Here, it is the
	default generator, TAO (for more details, cf. Sec.~\ref{sec:tao},
	while the random seed is set to a value initialized by the system
	clock, as no seed has been provided in the \sindarin\ input file.

	Now, the integration for the process \ttt{'ee'} is initialized, and
	information about the process (its name, the name of its process
	library, its index inside the library, and the process components out
	of which it consists, cf. Sec.~\ref{sec:processcomp}) are
	displayed. Then, the beam structure is shown, which in that case are
	symmetric partonic electron and positron beams with the center-of-mass
	energy provided by the user (360 GeV). The next step is the generation
	of the phase space, for which the default phase space method
	\ttt{wood} (for more details cf. Sec.~\ref{sec:wood}) is selected. The
	integration is performed, and the result with absolute and relative
	error, unweighting efficiency, accuracy, $\chi^2$ quality is shown.

	The final step is the event generation
	(cf. Chap.~\ref{chap:events}). The integration grids are now being
	used, again the random number generator is initialized. Finally, event
	generation of ten unweighted events starts (\whizard\ let us know to
	which integrated luminosity that would correspond), and events are
	written both in an internal (binary) event format as well as in the
	demanded LHE format. This concludes the \whizard\ run.

	After a more comprehensive introduction into the \sindarin\ steering
	language in the next chapter, Chap.~\ref{chap:sindarinintro}, we will
	discuss all the details of the different steps of this introductory
	example.


	\clearpage

	\section{WHIZARD in a Computing Environment}

	\subsection{Working on a Single Computer}
	\label{sec:workspace}

	After installation, \whizard\ is ready for use. There is a slight
	complication if \whizard\ has been installed in a location that is not
	in your standard search paths.

	In that case, to successfully run \whizard, you may either
	\begin{itemize}
	\item
	manually add \ttt{your-install-directory/bin} to your execution PATH\\
	and \ttt{your-install-directory/lib} to your library search path
	(LD\_LIBRARY\_PATH), or
	\item
	whenever you start a project, execute
	\begin{interaction}
	your-workspace> . your-install-directory/bin/whizard-setup.sh
	\end{interaction}
	which will enable the paths in your current environment, or
	\item
	source \ttt{whizard-setup.sh} script in your shell startup file.
	\end{itemize}
	In either case, try to call \ttt{whizard --help} in order to check
	whether this is done correctly.

	For a new \whizard\ project, you should set up a new (empty)
	directory. Depending on the complexity of your task, you may want to
	set up separate directories for each subproblem that you want to
	tackle, or even for each separate run. The location of the
	directories is arbitrary.

	To run, \whizard\ needs only a single input file, a \sindarin\ command
	script with extension \ttt{.sin} (by convention). Running
	\whizard\ is as simple as
	\begin{interaction}
	your-workspace> whizard your-input.sin
	\end{interaction}
	No other configuration files are needed. The total number of
	auxiliary and output files generated in a single run may get quite
	large, however, and they may clutter your workspace. This is the
	reason behind keeping subdirectories on a per-run basis.

	Basic usage of \whizard\ is explained in Chapter~\ref{chap:start}, for
	more details, consult the following chapters. In
	Sec.~\ref{sec:cmdline-options} we give an account of the command-line
	options that \whizard\ accepts.

	\subsection{Working Parallel on Several Computers}
	\label{sec:mpi}

	For integration (only VAMP2), \whizard\ supports parallel execution via MPI by communicating between parallel tasks on a single machine or distributed over several machines.

	During integration the calculation of channels is distributed along several workers where a master worker collects the results and adapts weights and grids.
	In wortwhile cases (e.g. high number of calls in one channel), the calculation of a single grid is additionally distributed.
	For that, we provide two different parallelization methods, which can be steered by
	\verb\|$vamp_parallel_method\|, implementing the dualistic parallelization approach between channels and single grids. The \ttt{simple} method provides a locally-fixed assignment approach without the need of intermediate communication between the MPI workers.
	Whereas the \ttt{load} method provides a global queue with a master worker acting as a (communication) governor, therefore, excluding itself as potential "computing" worker.
	The governor receives and distributes work requests from all other workers, and, finally, receives their results.
	The methods differ from each other only in the way how they distribute excessive workers, in the case, where there are more workers than channels.
	Here, the \ttt{load} method implements a balancing condition based on the channel weights in contrast to the simplistic ansatz.

	Both methods use a full non-blocking communication approach in order to collect the integration results of each channel after each iteration.
	After finishing the computation of a channel, the associated slave worker spawns a callback mechansim leading to the initialization of a sending process to the master.
	The master worker organizes, depending on the parallelization method, the correct closing of the sending process for a given channel by a matching receiving process.
	The callback approach allows us to concurrently communicate and produce integration results providing an increased parallelization portion, i.e.\ better HPC performance and utilization.

	The \ttt{load} method comes with a drawback that it does not work with less than three workers.
	Hence, we recommend (e.g.\ for debugging purpose of the parallel setup) to use the \ttt{simple} method, and to use the \ttt{load} method only for direct production runs.

	In order to use these advancements, \whizard\ requires an installed MPI-3.1 capable
	library (e.g. OpenMPI) and configuration and compilation with the appropriate flags,
	cf.~Sec.~\ref{sec:installation}.

	MPI support is only active when the integration method is set to VAMP2.
	Additionally, to preserve the numerical properties of a single task run, it is
	recommended to use the RNGstream as random number generator.
	\begin{code}
	$integration_method = 'vamp2'
	$rng_method = 'rng_stream'
	$vamp_parallel_method = 'simple' !! or 'load'
	\end{code}

	\whizard\ has then to be called by mpirun
	\begin{footnotesize}
	\begin{Verbatim}[frame=single]
	your-workspace> mpirun -f hostfile -np 4 --output-filename mpi.log whizard your-input.sin
	\end{Verbatim}
	\end{footnotesize}
	where the number of parallel tasks can be set by \ttt{-np} and a hostfile can be
	given by \ttt{--hostfile}. It is recommended to use \ttt{--output-filename} which
	lets mpirun redirect the standard (error) output to a file, for each worker separately.

	\subsubsection{Notes on Parallelization with MPI}

	The parallelization of \whizard\ requires that all instances of the
	parallel run be able to write and read all files produced by
	\whizard\ in a network file system as the current implementation does
	not handle parallel I/O. Usually, high-performance clusters have
	support for at least one network filesystem.

	Furthermore, not all functions of \whizard\ are currently supported or
	are only supported in a limited way in parallel mode. Currently the
	\verb\|?rebuild_<flags>\| for the phase space and the matrix element
	library are not yet available, as well as the calculation of matrix
	elements with resonance histories.

	Some features that have been missing in the very first implementation
	of the parallelized integration have now been made available, like
	the support of run IDs and the parallelization of the event generation.

	A final remark on the stability of the numerical results in terms of
	the number of workers involved. Under certain circumstances, results
	between different numbers of workers but using otherwise an identical
	\sindarin\ file can lead to slightly numerically different (but
	statistically compatible) results for integration or event generation
	This is related to the execution of the computational operations in
	MPI, which we use to reduce results from all workers. If the order of
	the numbers in the arithmetical operations changes, for example, by
	different setups of the workers, then the numerical results change
	slightly, which in turn is amplified under the influence of the
	adaptation. Nevertheless, the results are all statistically
	consistent.

	\subsection{Stopping and Resuming WHIZARD Jobs}

	On a Unix-like system, it is possible to prematurely stop running jobs
	by a \ttt{kill(1)} command, or by entering \ttt{Ctrl-C} on the
	terminal.

	If the system supports this, \whizard\ traps these signals. It also
	traps some signals that a batch operating system might issue, e.g.,
	for exceeding a predefined execution time limit. \whizard\ tries to
	complete the calculation of the current event and gracefully close
	open files. Then, the program terminates with a message and a nonzero
	return code. Usually, this should not take more than a fraction of a
	second.

	If, for any reason, the program does not respond to an interrupt, it
	is always possible to kill it by \ttt{kill -9}. A convenient method,
	on a terminal, would be to suspend it first by \ttt{Ctrl-Z} and then
	to kill the suspended process.

	The program is usually able to recover after being stopped. Simply
	run the job again from start, with the same input, all output files
	generated so far left untouched. The results obtained so far will be
	quickly recovered or gathered from files written in the previous run,
	and the actual time-consuming calculation is resumed near the point
	where it was interrupted.\footnote{This holds for simple workflow. In
	case of scans and repeated integrations of the same process, there
	may be name clashes on the written files which prevent resuming. A
	future \whizard\ version will address this problem.} If the
	interruption happened during an integration step, it is resumed after
	the last complete iteration. If it was during event generation, the
	previous events are taken from file and event generation is continued.

	The same mechanism allows for efficiently redoing a calculation with
	similar, somewhat modified input. For instance, you might want to add
	a further observable to event analysis, or write the events in a
	different format. The time for rerunning the program is determined
	just by the time it takes to read the existing integration or event
	files, and the additional calculation is done on the recovered
	information.

	By managing various checksums on its input and output files, \whizard\
	detects changes that affect further calculations, so it does a
	real recalculation only where it is actually needed. This applies to
	all steps that are potentially time-consuming: matrix-element code
	generation, compilation, phase-space setup, integration, and event
	generation. If desired, you can set command-line options or
	\sindarin\ parameters that explicitly discard previously generated
	information.


	\subsection{Files and Directories: default and customization}

	\whizard\ jobs take a small set of files as input. In many cases, this is
	just a single \sindarin\ script provided by the user.
	When running, \whizard\ can produce a set of auxiliary and output files:
	\begin{enumerate}
	\item
	\textbf{Job.}
	Files pertaining to the \whizard\ job as a whole. This is the default log
	file \ttt{whizard.log}.
	\item
	\textbf{Process compilation.} Files that originate from generating and
	compiling process code. If the default \oMega\ generator is used, these
	files include \fortran\ source code as well as compiled libraries that are
	dynamically linked to the running executable. The file names are derived
	from either the process-library name or the individual process names, as
	defined in the \sindarin\ input. The default library name is
	\ttt{default\_lib}.
	\item
	\textbf{Integration.}
	Files that are created by integration, i.e., when calculating the total cross
	section for a scattering process using the Monte-Carlo algorithm. The file
	names are derived from the process name.
	\item
	\textbf{Simulation.}
	Files that are created during simulation, i.e., generating event samples for
	a process or a set of processes. By default, the file names are derived
	from the name of the first process. Event-file formats are distinguished
	by appropriate file name extensions.
	\item
	\textbf{Result Analysis.}
	Files that are created by the internal analysis tools and written by the
	command \ttt{write\_analysis} (or \ttt{compile\_analysis}). The default
	base name is \ttt{whizard\_analysis}.
	\end{enumerate}

	A complex workflow with several processes, parameter sets, or runs, can easily
	lead to in file-name clashes or a messy working directory. Furthermore,
	running a batch job on a dedicated computing environment often requires
	transferring data from a user directory to the server and back.

	Custom directory and file names can be used to organize things and facilitate
	dealing with the environment, along with the available batch-system tools for
	coordinating file transfer.
	\begin{enumerate}
	\item
	\textbf{Job.}
	\begin{itemize}
	\item
	The \ttt{-L} option on the command line defines a custom base name for
	the log file.
	\item
	The \ttt{-J} option on the command line defines a job ID. For instance,
	this may be set to the job ID assigned by the batch system. Within the
	\sindarin\ script, the job ID is available as the string variable
	\ttt{\$job\_id} and can be used for constructing custom job-specific file
	and directory names, as described below.
	\end{itemize}
	\item
	\textbf{Process compilation.}
	\begin{itemize}
	\item
	The user can require the program to put all files created during the
	compilation step including the library to be linked, in a subdirectory of
	the working directory. To enable this, set the string variable
	\ttt{\$compile\_workspace} within the \sindarin\ script.
	\end{itemize}
	\item
	\textbf{Integration.}
	\begin{itemize}
	\item
	The value of the string variable \ttt{\$run\_id}, if set, is appended to
	the base name of all files created by integration, separated by dots. If
	the \sindarin\ script scans over parameters, varying the run ID avoids
	repeatedly overwriting files with identical name during the scan.
	\item
	The user can require the program to put the important files created during
	the integration step -- the phase-space configuration file and the
	\vamp\ grid files -- in a subdirectory of the working directory. To
	enable this, set the string variable \ttt{\$integrate\_workspace} within
	the \sindarin\ script. (\ttt{\$compile\_workspace} and
	\ttt{\$integrate\_workspace} may be set to the same value.)
	\end{itemize}
	Log files produced during the integration step are put in the working
	directory.
	\item
	\textbf{Simulation.}
	\begin{itemize}
	\item
	The value of the string variable \ttt{\$run\_id}, if set, identifies
	the specific integration run that is used for the event sample. It is
	also inserted into default event-sample file names.
	\item
	The variable \ttt{\$sample}, if set, defines an arbitrary base name for the
	files related to the event sample.
	\end{itemize}
	Files resulting from simulation are put in the working directory.
	\item
	\textbf{Result Analysis.}
	\begin{itemize}
	\item
	The variable \ttt{\$out\_file}, if set,
	defines an arbitrary base name for the analysis data and
	auxiliary files.
	\end{itemize}
	Files resulting from result analysis are put in the working directory.
	\end{enumerate}


	\subsection{Batch jobs on a different machine}

	It is possible to separate the tasks of process-code compilation, integration,
	and simulation, and execute them on different machines. To make use of
	this feature, the local and remote machines including all
	installed libraries that are relevant for \whizard, must be
	binary-compatible.
	\begin{enumerate}
	\item
	Process-code compilation may be done once on a local machine, while the
	time-consuming tasks of integration and event generation for specific
	parameter sets are delegated to a remote machine, e.g., a batch cluster. To
	enable this, prepare a \sindarin\ script that just produces process code
	(i.e., terminates with a \ttt{compile} command) for the local machine. You
	may define \ttt{\$compile\_workspace} such that all generated code
	conveniently ends up in a single subdirectory.

	To start the batch job, transfer the workspace subdirectory to the remote
	machine
	and start \whizard\ there. The \sindarin\ script on the remote machine must
	include the local script unchanged in all parts that are relevant for
	process definition. The program will recognize the contents of the
	workspace, skip compilation and instead link the process library immediately.
	To proceed further, the script should define the run-specific parameters and
	contain the appropriate commands for integration and simulation.
	\item
	Analogously, you may execute both process-code compilation and integration
	locally, but generate event samples on a remote machine. To this end,
	prepare a \sindarin\ script that produces process code and computes integrals
	(i.e., terminates with an \ttt{integrate} command) for the local machine.
	You may define \ttt{\$compile\_workspace} and \ttt{\$integrate\_workspace}
	(which may coincide) such that all generated code, phase-space and
	integration grid data conveniently end up in subdirectories.

	To start the batch job, transfer the workspace(s) to the remote machine and
	start \whizard\ there. The \sindarin\ script on the remote machine must
	include the local script unchanged in all parts that are relevant for
	process definition and integration. The program will recognize the contents
	of the workspace, skip compilation and integration and instead load the
	process library and integration results immediately. To proceed further,
	the script should define the sample-specific parameters and contain the
	appropriate commands for simulation.
	\end{enumerate}

	To simplify transferring whole directories, \whizard\ supports the
	\ttt{--pack} and \ttt{--unpack} options. You may specify any number of these
	options for a \whizard\ run. (The feature relies on the GNU version of the
	\ttt{tar} utility.)

	For instance,
	\begin{code}
	whizard script1.sin --pack my_ws
	\end{code}
	runs \whizard\ with the \sindarin\ script \ttt{script1.sin} as input, where
	within the script you have defined
	\begin{code}
	$compile_workspace = "my_ws"
	\end{code}
	as the target directory for process-compilation files. After completion, the
	program will tar and gzip the target directory as \ttt{my\_ws.tgz}. You
	should copy this file to the remote machine as one of the job's input files.

	On the remote machine, you can then run the program with
	\begin{code}
	whizard script2.sin --unpack my_ws.tgz
	\end{code}
	where \ttt{script2.sin} should include \ttt{script1.sin}, and add integration
	or simulation commands. The contents of \ttt{ws.tgz} will thus be unpacked
	and reused on the remote machine, instead of generating new process code.



	\subsection{Static Linkage}

	In its default running mode, \whizard\ compiles process-specific matrix
	element code on the fly and dynamically links the resulting library. On the
	computing server, this requires availability of the appropriate \fortran\
	compiler, as well as the \ocaml\ compiler suite, and the dynamical linking
	feature.

	Since this may be unavailable or undesired, there is a possibility to
	distribute \whizard\ as a statically linked executable that contains a
	pre-compiled library of processes. This removes the need for the \fortran\
	compiler, the \ocaml\ system, and extra dynamic linking. Any external
	libraries that are accessed (the \fortran\ runtime environment, and possibly
	some dynamically linked external libraries and/or the \cpp\ runtime library,
	must still be available on the target system, binary-compatible. Otherwise,
	there is no need for transferring the complete \whizard\ installation or
	process-code compilation data.

	Generating, compiling and linking matrix element code is done in advance on a
	machine that can access the required tools and produces compatible libraries.
	This procedure is accomplished by \sindarin\ commands, explained below in
	Sec.~\ref{sec:static}.

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\newpage

	\section{Troubleshooting}
	\label{sec:troubleshooting}

	In this section, we list known issues or problems and give advice on
	what can be done in case something does not work as intended.

	\subsection{Possible (uncommon) build problems}
	\label{sec:buildproblems}

	\subsubsection{\ocaml\ versions and \oMega\ builds}

	For the matrix element generator \oMega\ of \whizard\, the functional
	programming language \ocaml\ is used. Unfortunately, the versions of
	the \ocaml\ compiler from 3.12.0 on broke backwards
	compatibility. Therefore, versions of \oMega/\whizard\ up to v2.0.2
	only compile with older versions (3.04 to 3.11 works). This has been
	fixed in all \whizard\ versions from 2.0.3 on.

	\subsubsection{Identical Build and Source directories}

	There is a problem that only occurred with version 2.0.0 and has been
	corected for all follow-up versions. It can only appear if you
	compile the \whizard\ sources in the source directory. Then an error
	like this may occur:
	\begin{footnotesize}
	\begin{Verbatim}[frame=single]
	...
	libtool: compile: gfortran -I../misc -I../vamp -g -O2 -c processes.f90 -fPIC -o
	.libs/processes.o
	libtool: compile: gfortran -I../misc -I../vamp -g -O2 -c processes.f90 -o
	processes.o >/dev/null 2>&1
	make[2]: *** No rule to make target `limits.lo', needed by `decays.lo'. Stop.
	...
	make: *** [all-recursive] Error 1
	\end{Verbatim}
	\end{footnotesize}
	In this case, please unpack a fresh copy of \whizard\ and configure it
	in a separate directory (not necessarily a subdirectory). Then the
	compilation will go through:
	\begin{footnotesize}
	\begin{Verbatim}[frame=single]
	$ zcat whizard-3.0.3.tar.gz \| tar xf -
	$ cd whizard-3.0.3
	$ mkdir _build
	$ cd _build
	$ ../configure FC=gfortran
	$ make
	\end{Verbatim}
	\end{footnotesize}
	The developers use this setup to be able to test different
	compilers. Therefore building in the same directory is not as
	thoroughly tested. This behavior has been patched from version 2.0.1
	on. But note that in general it is always adviced to keep
	build and source directory apart from each other.

	%%%%%

	\subsection{What happens if \whizard\ throws an error?}
	\label{ref:errors}

	\subsubsection{Particle name special characters in process
	declarations}

	Trying to use a process declaration like
	\begin{code}
	process foo = e-, e+ => mu-, mu+
	\end{code}
	will lead to a \sindarin\ syntax error:
	\begin{Code}
	process foo = e-, e+ => mu-, mu+
	^^
	\| Expected syntax: SEQUENCE <cmd_process> = process <process_id> '=' <process_p
	\| Found token: KEYWORD: '-'
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Syntax error (at or before the location indicated above)
	******************************************************************************
	******************************************************************************
	\end{Code}
	\whizard\ tries to interpret the minus and plus signs as operators
	(\ttt{KEYWORD: '-'}), so you have to quote the particle names:
	\ttt{process foo = "e-", "e+" => "mu-", "mu+"}.


	\subsubsection{Missing collider energy}

	This happens if you forgot to set the collider energy in the
	integration of a scattering process:
	\begin{Code}
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Colliding beams: sqrts is zero (please set sqrts)
	******************************************************************************
	******************************************************************************
	\end{Code}
	This will solve your problem:
	\begin{code}
	sqrts = <your_energy>
	\end{code}

	\subsubsection{Missing process declaration}

	If you try to integrate or simulate a process that has not declared
	before (and is also not available in a library that might be loaded),
	\whizard\ will complain:
	\begin{Code}
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Process library doesn't contain process 'f00'
	******************************************************************************
	******************************************************************************
	\end{Code}
	Note that this could sometimes be a simple typo, e.g. in that case an
	\ttt{integrate (f00)} instead of \ttt{integrate (foo)}

	\subsubsection{Ambiguous initial state without beam declaration}

	When the user declares a process with a flavor sum in the initial
	state, e.g.
	\begin{code}
	process qqaa = u:d, U:D => A, A
	sqrts = <your_energy>
	integrate (qqaa)
	\end{code}
	then a fatal error will be issued:
	\begin{Code}
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Setting up process 'qqaa':
	*** --------------------------------------------
	*** Inconsistent initial state. This happens if either
	*** several processes with non-matching initial states
	*** have been added, or for a single process with an
	*** initial state flavor sum. In that case, please set beams
	*** explicitly [singling out a flavor / structure function.]
	******************************************************************************
	******************************************************************************
	\end{Code}
	What now? Either a structure function providing a tensor structure in
	flavors has to be provided like
	\begin{code}
	beams = p, pbar => pdf_builtin
	\end{code}
	or, if the partonic process was intended, a specific flavor has to be
	singled out,
	\begin{code}
	beams = u, U
	\end{code}
	which would take only the up-quarks. Note that a sum over process
	components with varying initial states is not possible.

	\subsubsection{Invalid or unsupported beam structure}

	An error message like
	\begin{Code}
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Beam structure: [.......] not supported
	******************************************************************************
	******************************************************************************
	\end{Code}
	This happens if you try to use a beam structure with is either not
	supported by \whizard\ (meaning that there is no phase-space
	parameterization for Monte-Carlo integration available in order to
	allow an efficient sampling), or you have chosen a combination of beam
	structure functions that do not make sense physically. Here is an
	example for the latter (lepton collider ISR applied to protons, then
	proton PDFs):
	\begin{code}
	beams = p, p => isr => pdf_builtin
	\end{code}

	\subsubsection{Mismatch in beams}

	Sometimes you get a rather long error output statement followed by a
	fatal error:
	\begin{Code}
	Evaluator product
	First interaction
	Interaction: 6
	Virtual:
	Particle 1
	[momentum undefined]
	[.......]
	State matrix: norm = 1.000000000000E+00
	[f(2212)]
	[f(11)]
	[f(92) c(1 )]
	[f(-6) c(-1 )] => ME(1) = ( 0.000000000000E+00, 0.000000000000E+00)
	[.......]
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Product of density matrices is empty
	*** --------------------------------------------
	*** This happens when two density matrices are convoluted
	*** but the processes they belong to (e.g., production
	*** and decay) do not match. This could happen if the
	*** beam specification does not match the hard
	*** process. Or it may indicate a WHIZARD bug.
	******************************************************************************
	******************************************************************************
	\end{Code}
	As \whizard\ indicates, this could have happened because the hard
	process setup did not match the specification of the beams as in:
	\begin{code}
	process neutral_current_DIS = e1, u => e1, u
	beams_momentum = 27.5 GeV, 920 GeV
	beams = p, e => pdf_builtin, none
	integrate (neutral_current_DIS)
	\end{code}
	In that case, the order of the beam particles simply was wrong,
	exchange proton and electron (together with the structure functions)
	into \ttt{beams = e, p => none, pdf\_builtin}, and \whizard\ will be
	happy.

	\subsubsection{Unstable heavy beam particles}

	If you try to use unstable particles as beams that can potentially
	decay into the final state particles, you might encounter the
	following error message:
	\begin{Code}
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Phase space: Initial beam particle can decay
	******************************************************************************
	******************************************************************************
	\end{Code}
	This happens basically only for processes in testing/validation (like
	$t \bar t \to b \bar b$). In principle, it could also happen in a real
	physics setup, e.g. when simulating electron pairs at a muon collider:
	\begin{code}
	process mmee = "mu-", "mu+" => "e-", "e+"
	\end{code}
	However, \whizard\ at the moment does not allow a muon width, and so
	\whizard\ is not able to decay a muon in a scattering process.
	A possibile decay of the beam particle into (part of) the final state
	might lead to instabilities in the phase space setup. Hence, \whizard\
	do not let you perform such an integration right away. When you
	nevertheless encounter such a rare occasion in your setup, there is a
	possibility to convert this fatal error into a simple warning by
	setting the flag:
	\begin{code}
	?fatal_beam_decay = false
	\end{code}

	\subsubsection{Impossible beam polarization}

	If you specify a beam polarization that cannot correspond to any
	physically allowed spin density matrix, e.g.,
	\begin{code}
	beams = e1, E1
	beams_pol_density = @(-1), @(1:1:.5, -1, 1:-1)
	\end{code}
	\whizard\ will throw a fatal
	error like this:
	\begin{Code}
	Trace of matrix square = 1.4444444444444444
	Polarization: spin density matrix
	spin type = 2
	multiplicity = 2
	massive = F
	chirality = 0
	pol.degree = 1.0000000
	pure state = F
	@(+1: +1: ( 3.333333333333E-01, 0.000000000000E+00))
	@(-1: -1: ( 6.666666666667E-01, 0.000000000000E+00))
	@(-1: +1: ( 6.666666666667E-01, 0.000000000000E+00))
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Spin density matrix: not permissible as density matrix
	******************************************************************************
	******************************************************************************
	\end{Code}

	\subsubsection{Beams with crossing angle}

	Specifying a crossing angle (e.g. at a linear lepton collider) without
	explicitly setting the beam momenta,
	\begin{code}
	sqrts = 1 TeV
	beams = e1, E1
	beams_theta = 0, 10 degree
	\end{code}
	triggers a fatal:
	\begin{Code}
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Beam structure: angle theta/phi specified but momentum/a p undefined
	******************************************************************************
	******************************************************************************
	\end{Code}
	In that case the single beam momenta have to be explicitly set:
	\begin{code}
	beams = e1, E1
	beams\_momentum = 500 GeV, 500 GeV
	beams\_theta = 0, 10 degree
	\end{code}

	\subsubsection{Phase-space generation failed}

	Sometimes an error might be issued that \whizard\ could not generate a
	valid phase-space parameterization:
	\begin{Code}
	\| Phase space: ... failed. Increasing phs_off_shell ...
	\| Phase space: ... failed. Increasing phs_off_shell ...
	\| Phase space: ... failed. Increasing phs_off_shell ...
	\| Phase space: ... failed. Increasing phs_off_shell ...
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Phase-space: generation failed
	******************************************************************************
	******************************************************************************
	\end{Code}
	You see that \whizard\ tried to increase the number of off-shell lines
	that are taken into account for the phase-space setup. The second most
	important parameter for the phase-space setup, \ttt{phs\_t\_channel},
	however, is not increased automatically. Its default value is $6$, so
	e.g. for the process $e^+ e^- \to 8\gamma$ you will run into the
	problem above. Setting
	\begin{code}
	phs_off_shell = <n>-1
	\end{code}
	where \ttt{<n>} is the number of final-state particles will solve the problem.

	\subsubsection{Non-converging process integration}

	There could be several reasons for this to happen. The most prominent
	one is that no cuts have been specified for the process (\whizard\ttt{2}
	does not apply default cuts), and there are singular regions in the
	phase space over which the integration stumbles. If cuts have been
	specified, it could be that they are not sufficient. E.g. in $pp \to
	jj$ a distance cut between the two jets prevents singular collinear
	splitting in their generation, but if no $p_T$ cut have been set,
	there is still singular collinear splitting from the beams.

	\subsubsection{Why is there no event file?}

	If no event file has been generated, \whizard\ stumled over some error
	and should have told you, or, you simply forgot to set a \ttt{simulate}
	command for your process. In case there was a \ttt{simulate} command
	but the process under consideration is not possible (e.g. a typo,
	\ttt{e1, E1 => e2, E3} instead of \ttt{e1, E1 => e3, E3}), then you
	get an error like that:
	\begin{Code}
	******************************************************************************
	*** ERROR: Simulate: no process has a valid matrix element.
	******************************************************************************
	\end{Code}

	\subsubsection{Why is the event file empty?}

	In order to get events, you need to set either a desired number of
	events:
	\begin{code}
	n_events = <integer>
	\end{code}
	or you have to specify a certain integrated luminosity (the default
	unit being inverse femtobarn:
	\begin{code}
	luminosity = <real> / 1 fbarn
	\end{code}
	In case you set both, \whizard\ will take the one that leads to the
	higher number of events.

	\subsubsection{Parton showering fails}

	For BSM models containing massive stable or long-lived particles
	parton showering with \pythiasix\ fails:
	\begin{Code}
	Advisory warning type 3 given after 0 PYEXEC calls:
	(PYRESD:) Failed to decay particle 1000022 with mass 15.000
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Simulation: failed to generate valid event after 10000 tries
	******************************************************************************
	******************************************************************************
	\end{Code}
	The solution to that problem is discussed in Sec.~\ref{sec:pythia6}.

	\vspace{1cm}


	%%%%%

	\subsection{Debugging, testing, and validation}


	\subsubsection{Catching/tracking arithmetic exceptions}

	Catching arithmetic exceptions is not automatically supported by
	\fortran\ compilers. In general, flags that cause the compiler to keep
	track of arithmetic exceptions are diminishing the maximally possible
	performance, and hence they should not be used in production
	runs. Hence, we refrained from making these flags a default.
	They can be added using the \ttt{FCFLAGS = {\em <flags>}} settings during
	configuration. For the \ttt{NAG} \fortran\ compiler we use the flags
	\ttt{-C=all -nan -gline} for debugging purposes. For the \ttt{gfortran}
	compilers, the flags \ttt{-ffpe-trap=invalid,zero,overflow} are the
	corresponding debugging flags. For tests, debugging or first sanity
	checks on your setup, you might want to make use of these flags in
	order to track possible numerical exceptions in the produced code.
	Some compilers started to include \ttt{IEEE} exception handling
	support (\ttt{Fortran 2008} status), but we do not use these
	implementations in the \whizard\ code (yet).


	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{Steering WHIZARD: \sindarin\ Overview}
	\label{chap:sindarinintro}


	\section{The command language for WHIZARD}
	A conventional physics application program gets its data from a set of input
	files. Alternatively, it is called as a library, so the user has to write his
	own code to interface it, or it combines these two approaches. \whizard~1 was
	built in this way: there were some input files which were written by the user,
	and it could be called both stand-alone or as an external library.

	\whizard~2 is also a stand-alone program. It comes with its own full-fledged
	script language, called \sindarin. All interaction between the user and the
	program is done in \sindarin\ expressions, commands, and scripts. Two main
	reasons led us to this choice:
	\begin{itemize}
	\item
	In any nontrivial physics study, cuts and (parton- or hadron-level) analysis
	are of central importance. The task of specifying appropriate kinematics
	and particle selection for a given process is well defined, but it is
	impossible to cover all possiblities in a simple format like the cut files
	of \whizard~1.

	The usual way of dealing with this problem is to write analysis driver code
	(often in \cpp, using external libraries for Lorentz algebra etc. However,
	the overhead of writing correct \cpp\ or \ttt{Fortran} greatly blows up problems
	that could be formulated in a few lines of text.
	\item
	While many problems lead to a repetitive workflow (process definition,
	integration, simulation), there are more involved tasks that involve
	parameter scans, comparisons of different processes, conditional execution,
	or writing output in widely different formats. This is easily done by a
	steering script, which should be formulated in a complete language.
	\end{itemize}
	The \sindarin\ language is built specifically around event analysis, suitably
	extended to support steering, including data types, loops, conditionals, and
	I/O.

	It would have been possible to use an established general-purpose language for
	these tasks. For instance, \ocaml\ which is a functional language would be a
	suitable candidate, and the matrix-element generator \oMega\ is written in that
	language. Another candidate would be a popular scripting language such as
	PYTHON.

	We started to support interfaces for commonly used languages: prime
	examples for \ttt{C}, \cpp, and PYTHON are found in the
	\ttt{share/interfaces} subdirectory. However, introducing a
	special-purpose language has the three distinct
	advantages: First, it is compiled and executed by the very \ttt{Fortran} code that
	handles data and thus accesses it without interfaces. Second, it can be
	designed with a syntax especially suited to the task of event handling and
	Monte-Carlo steering, and third, the user is not forced to learn all those
	features of a generic language that are of no relevance to the application he/she
	is interested in.


	\section{\sindarin\ scripts}

	A \sindarin\ script tells the \whizard\ program what it has to do. Typically,
	the script is contained in a file which you (the user) create. The file name
	is arbitrary; by convention, it has the extension `\verb\|.sin\|'.
	\whizard\ takes the file name as its argument on the command line and
	executes the contained script:
	\begin{verbatim}
	/home/user$ whizard script.sin
	\end{verbatim}
	Alternatively, you can call \whizard\ interactively and execute
	statements line by line; we describe this below in Sec.\ref{sec:whish}.

	A \sindarin\ script is a sequence of \emph{statements}, similar to the
	statements in any imperative language such as \ttt{Fortran} or
	\ttt{C}. Examples of statements are commands like \ttt{integrate},
	variable declarations like \ttt{logical ?flag} or assigments like
	\ttt{mH = 130 GeV}.

	The script is free-form, i.e., indentation, extra whitespace and
	newlines are syntactically insignificant. In contrast to most
	languages, there is no statement separator. Statements simply follow each
	other, just separated by whitespace.
	\begin{code}
	statement1 statement2
	statement3
	statement4
	\end{code}
	Nevertheless, for clarity we recommend to
	write one statement per line where possible, and to use proper
	indentation for longer statements, nested and bracketed expressions.

	A command may consist of a \emph{keyword}, a list of \emph{arguments} in
	parantheses \ttt{(}\ldots\ttt{)}, and an \emph{option} script which
	itself is a sequence of statements.
	\begin{code}
	command
	command_with_args (arg1, arg2)
	command_with_option { option }
	command_with_options (arg) {
	option_statement1
	option_statement2
	}
	\end{code}
	As a rule, parentheses \ttt{()} enclose arguments and expressions, as
	you would expect. Arguments enclosed in square brackets \ttt{[]} also
	exist. They have a special meaning, they denote subevents
	(collections of momenta) in event analysis. Braces \ttt{\{\}} enclose
	blocks of \sindarin\ code. In particular, the option script
	associated with a command is a block of code that may contain local
	parameter settings, for instance. Braces always indicate a scoping
	unit, so parameters will be restored their previous values when the
	execution of that command is completed.

	The script can contain comments. Comments are initiated by either a \verb\|#\|
	or a \verb\|!\| character and extend to the end of the current line.
	\begin{code}
	statement
	# This is a comment
	statement ! This is also a comment
	\end{code}


	%%%%%%%%%%%%%%%

	\section{Errors}
	\label{sec:errors}

	Before turning to proper \sindarin\ syntax, let us consider error messages.
	\sindarin\ distinguishes syntax errors and runtime errors.

	Syntax errors are recognized when the script is read and compiled,
	before any part is executed. Look at this example:
	\begin{code}
	process foo = u, ubar => d, dbar
	md = 10
	integrade (foo)
	\end{code}
	\whizard\ will fail with the error message
	\begin{interaction}
	sqrts = 1 TeV
	integrade (foo)
	^^
	\| Expected syntax: SEQUENCE <cmd_num> = <var_name> '=' <expr>
	\| Found token: KEYWORD: '('
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Syntax error (at or before the location indicated above)
	******************************************************************************
	******************************************************************************
	WHIZARD run aborted.
	\end{interaction}
	which tells you that you have misspelled the command
	\verb\|integrate\|, so the compiler tried to interpret it as a variable.

	Runtime errors are categorized by their severity. A warning is simply
	printed:
	\begin{interaction}
	Warning: No cuts have been defined.
	\end{interaction}
	This indicates a condition that is suspicious, but may actually be
	intended by the user.

	When an error is encountered, it is printed with more emphasis
	\begin{interaction}
	******************************************************************************
	*** ERROR: Variable 'md' set without declaration
	******************************************************************************
	\end{interaction}
	and the program tries to continue. However, this usually indicates
	that there is something wrong. (The $d$ quark is defined
	massless, so \verb\|md\| is not a model parameter.) \whizard\ counts
	errors and warnings and tells you at the end
	\begin{interaction}
	\| There were 1 error(s) and no warnings.
	\end{interaction}
	just in case you missed the message.

	Other errors are considered fatal, and execution stops at this point.
	\begin{interaction}
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Colliding beams: sqrts is zero (please set sqrts)
	******************************************************************************
	******************************************************************************
	\end{interaction}
	Here, \whizard\ was unable to do anything sensible. But at least (in
	this case) it told the user what to do to resolve the problem.

	%%%%%%%%%%%%%%%

	\section{Statements}
	\label{sec:statements}

	\sindarin\ statements are executed one by one. For an overview, we
	list the most common statements in the order in which they typically
	appear in a \sindarin\ script, and quote the basic syntax and simple
	examples. This should give an impression on the \whizard's
	capabilities and on the user interface. The list is not complete.
	Note that there are no
	mandatory commands (although an empty \sindarin\ script is not really
	useful). The details and options are explained in later sections.

	\subsection{Process Configuration}

	\subsubsection{model}
	\begin{syntax}
	model = \var{model-name}
	\end{syntax}
	This assignment sets or resets the current physics model. The
	Standard Model is already preloaded, so the \ttt{model} assignment
	applies to non-default models. Obviously, the model must be known to
	\whizard. Example:
	\begin{code}
	model = MSSM
	\end{code}
	See Sec.~\ref{sec:models}.

	\subsubsection{alias}
	\begin{syntax}
	alias \var{alias-name} = \var{alias-definition}
	\end{syntax}
	Particles are specified by their names. For most particles, there
	are various equivalent names. Names containing special characters
	such as a \verb\|+\| sign have to be quoted. The \ttt{alias} assignment
	defines an alias for a list of particles. This is useful for setting
	up processes with sums over flavors, cut expressions, and more. The
	alias name is then used like a simple particle name. Example:
	\begin{syntax}
	alias jet = u:d:s:U:D:S:g
	\end{syntax}
	See Sec.~\ref{sec:alias}.


	\subsubsection{process}
	\begin{syntax}
	process \var{tag} = \var{incoming} \verb\|=>\| \var{outgoing}
	\end{syntax}
	Define a process. You give the process a name \var{tag} by which it is
	identified later, and specify the incoming and outgoing particles,
	and possibly options. You can define an arbitrary number of processes
	as long as they are distinguished by their names. Example:
	\begin{code}
	process w_plus_jets = g, g => "W+", jet, jet
	\end{code}
	See Sec.~\ref{sec:processes}.


	\subsubsection{sqrts}
	\begin{syntax}
	sqrts = \var{energy-value}
	\end{syntax}
	Define the center-of-mass energy for collision processes. The default
	setup will assume head-on central collisions of two beams. Example:
	\begin{code}
	sqrts = 500 GeV
	\end{code}
	See Sec.~\ref{sec:beam-setup}.


	\subsubsection{beams}
	\begin{syntax}
	beams = \var{beam-particles} \\
	beams = \var{beam-particles} => \var{structure-function-setup}
	\end{syntax}
	Declare beam particles and properties. The current value of \ttt{sqrts} is
	used, unless specified otherwise. Example:
	\begin{code}
	beams = u:d:s, U:D:S => lhapdf
	\end{code}
	With options, the assignment allows for
	defining beam structure in some detail. This includes beamstrahlung and ISR
	for lepton colliders, precise structure function definition for hadron
	colliders, asymmetric beams, beam polarization, and more. See
	Sec.~\ref{sec:beams}.


	\subsection{Parameters}

	\subsubsection{Parameter settings}
	\begin{syntax}
	\var{parameter} = \var{value} \\
	\var{type} \var{user-parameter} \\
	\var{type} \var{user-parameter} = \var{value}
	\end{syntax}
	Specify a value for a parameter. There are predefined parameters that affect
	the behavior of a command, model-specific parameters (masses, couplings), and
	user-defined parameters. The latter have to be declared with a type, which
	may be \ttt{int} (integer), \ttt{real}, \ttt{complex}, \ttt{logical},
	\ttt{string}, or \ttt{alias}. Logical parameter
	names begin with a question mark, string parameter names with a dollar sign.
	Examples:
	\begin{code}
	mb = 4.2 GeV
	?rebuild_grids = true
	real mass_sum = mZ + mW
	string $message = "This is a string"
	\end{code}
	% $
	The value need not be a literal, it can be an arbitrary expression of the
	correct type. See Sec.~\ref{sec:variables}.


	\subsubsection{read\_slha}
	\begin{syntax}
	read\_slha (\var{filename})
	\end{syntax}
	This is useful only for supersymmetric models: read a parameter file
	in the SUSY Les Houches Accord format. The file defines parameter
	values and, optionally, decay widths, so this command removes the need
	for writing assignments for each of them.
	\begin{code}
	read_slha ("sps1a.slha")
	\end{code}
	See Sec.~\ref{sec:slha}.


	\subsubsection{show}
	\begin{syntax}
	show (\var{data-objects})
	\end{syntax}
	Print the current value of some data object. This includes not just
	variables, but also models, libraries, cuts, etc. This is rather a
	debugging aid, so don't expect the output to be concise in the latter
	cases. Example:
	\begin{code}
	show (mH, wH)
	\end{code}
	See Sec.~\ref{sec:I/O}.


	\subsubsection{printf}
	\begin{syntax}
	printf \var{format-string} (\var{data-objects})
	\end{syntax}
	Pretty-print the data objects according to the given format string.
	If there are no data objects, just print the format string.
	This command is borrowed from the \ttt{C} programming language; it is
	actually an interface to the system's \ttt{printf(3)} function. The
	conversion specifiers are restricted to \ttt{d,i,e,f,g,s},
	corresponding to the output of integer, real, and string variables.
	Example:
	\begin{code}
	printf "The Higgs mass is %f GeV" (mH)
	\end{code}
	See Sec.~\ref{sec:I/O}.


	\subsection{Integration}

	\subsubsection{cuts}
	\begin{syntax}
	cuts = \var{logical-cut-expression}
	\end{syntax}
	The cut expression is a logical macro expression that is evaluated for each
	phase space point during integration and event generation. You may construct
	expressions out of various observables that are computed for the (partonic)
	particle content of the current event. If the expression evaluates to
	\verb\|true\|, the matrix element is calculated and the event is used. If it
	evaluates to \verb\|false\|, the matrix element is set zero and the event is
	discarded. Note that for collisions the expression is evaluated in the
	lab frame, while for decays it is evaluated in the rest frame of the
	decaying particle. In case you want to impose cuts on a factorized
	process, i.e. a combination of a production process and one or more
	decay processes, you have to use the \ttt{selection} keyword
	instead.

	Example for the keyword \ttt{cuts}:
	\begin{code}
	cuts = all Pt > 20 GeV [jet]
	and all mZ - 10 GeV < M < mZ + 10 GeV [lepton, lepton]
	and no abs (Eta) < 2 [jet]
	\end{code}
	See Sec.~\ref{sec:cuts}.


	\subsubsection{integrate}
	\begin{syntax}
	integrate (\var{process-tags})
	\end{syntax}
	Compute the total cross section for a process. The command takes into account
	the definition of the process, the beam setup, cuts, and parameters as defined
	in the script. Parameters may also be specified as options to the command.

	Integration is necessary for each process for which you want to know total or
	differential cross sections, or event samples. Apart from computing a value,
	it sets up and adapts phase space and integration grids that are used in event
	generation. If you just need an event sample, you can omit an explicit
	\ttt{integrate} command; the \ttt{simulate} command will call it
	automatically. Example:
	\begin{code}
	integrate (w_plus_jets, z_plus_jets)
	\end{code}
	See Sec.~\ref{sec:integrate}.

	\subsubsection{?phs\_only/n\_calls\_test}
	\begin{syntax}
	integrate (\var{process-tag}) \{ ?phs\_only = true n\_calls\_test = 1000 \}
	\end{syntax}
	These are just optional settings for the \ttt{integrate} command
	discussed just a second ago. The \ttt{?phs\_only = true} (note that
	variables starting with a question mark are logicals) option tells
	\whizard\ to prepare a process for integration, but instead of
	performing the integration, just to generate a phase space
	parameterization. \ttt{n\_calls\_test = <num>} evaluates the sampling
	function for random integration channels and random momenta. \vamp\
	integration grids are neither generated nor used, so the channel
	selection corresponds to the first integration pass, before any grids
	or channel weights are adapted. The number of sampling points is
	given by \verb\|<num>\|. The output contains information about the
	timing, number of sampling points that passed the kinematics
	selection, and the number of matrix-element values that were actually
	evaluated. This command is useful mainly for debugging and
	diagnostics. Example:
	\begin{code}
	integrate (some_large_process) { ?phs_only = true n_calls_test = 1000 }
	\end{code}
	(Note that there used to be a separate command
	\ttt{matrix\_element\_test} until version 2.1.1 of \whizard\ which has
	been discarded in order to simplify the \sindarin\ syntax.)

	\subsection{Events}

	\subsubsection{histogram}
	\begin{syntax}
	histogram \var{tag} (\var{lower-bound}, \var{upper-bound}) \\
	histogram \var{tag} (\var{lower-bound}, \var{upper-bound}, \var{step}) \\
	\end{syntax}
	Declare a histogram for event analysis. The histogram is filled by an
	analysis expression, which is evaluated once for each event during a
	subsequent simulation step. Example:
	\begin{code}
	histogram pt_distribution (0, 150 GeV, 10 GeV)
	\end{code}
	See Sec.~\ref{sec:histogram}.


	\subsubsection{plot}
	\begin{syntax}
	plot \var{tag}
	\end{syntax}
	Declare a plot for displaying data points. The plot may be filled by an
	analysis expression that is evaluated for each event; this would result in a
	scatter plot. More likely, you will use this feature for displaying data such
	as the energy dependence of a cross section. Example:
	\begin{code}
	plot total_cross_section
	\end{code}
	See Sec.~\ref{sec:plot}.


	\subsubsection{selection}
	\begin{syntax}
	selection = \var{selection-expression}
	\end{syntax}
	The selection expression is a logical macro expression that is evaluated once
	for each event. It is applied to the event record,
	after all decays have been executed (if any). It is therefore intended
	e.g. for modelling detector acceptance cuts etc. For unfactorized
	processes the usage of \ttt{cuts} or \ttt{selection} leads to
	the same results. Events for which the selection expression evaluates
	to false are dropped; they are neither analyzed nor written to any
	user-defined output file. However, the dropped events are written to
	\whizard's native event file. For unfactorized processes it is
	therefore preferable to implement all cuts using the \ttt{cuts}
	keyword for the integration, see \ttt{cuts} above.
	Example:
	\begin{code}
	selection = all Pt > 50 GeV [lepton]
	\end{code}
	The syntax is generically the same as for the \ttt{cuts
	expression}, see Sec.~\ref{sec:cuts}. For more information see also
	Sec.~\ref{sec:analysis}.


	\subsubsection{analysis}
	\begin{syntax}
	analysis = \var{analysis-expression}
	\end{syntax}
	The analysis expression is a logical macro expression that is evaluated once
	for each event that passes the integration and selection cuts in a
	subsequent simulation step. The
	expression has type logical in analogy with the cut expression; however, its
	main use will be in side effects caused by embedded \ttt{record} expressions.
	The \ttt{record} expression books a value, calculated from observables
	evaluated for the current event, in one of the predefined histograms or plots.
	Example:
	\begin{code}
	analysis = record pt_distribution (eval Pt [photon])
	and record mval (eval M [lepton, lepton])
	\end{code}
	See Sec.~\ref{sec:analysis}.


	\subsubsection{unstable}
	\begin{syntax}
	unstable \var{particle} (\var{decay-channels})
	\end{syntax}
	Specify that a particle can decay, if it occurs in the final state of a
	subsequent simulation step. (In the integration step, all final-state
	particles are considered stable.) The decay channels are processes which
	should have been declared before by a \ttt{process} command
	(alternatively, there are options that \whizard\ takes care of this
	automatically; cf. Sec.~\ref{sec:decays}). They may be
	integrated explicitly, otherwise the \ttt{unstable} command will take care of
	the integration before particle decays are generated. Example:
	\begin{code}
	unstable Z (z_ee, z_jj)
	\end{code}
	Note that the decay is an on-shell approximation. Alternatively, \whizard\ is
	capable of generating the final state(s) directly, automatically including the
	particle as an internal resonance together with irreducible background.
	Depending on the physical problem and on the complexity of the matrix-element
	calculation, either option may be more appropriate.

	See Sec.~\ref{sec:decays}.


	\subsubsection{n\_events}
	\begin{syntax}
	n\_events = \var{integer}
	\end{syntax}
	Specify the number of events that a subsequent simulation step should produce.
	By default, simulated events are unweighted. (Unweighting is done by a
	rejection operation on weighted events, so the usual caveats on event
	unweighting by a numerical Monte-Carlo generator do apply.) Example:
	\begin{code}
	n_events = 20000
	\end{code}
	See Sec.~\ref{sec:simulation}.


	\subsubsection{simulate}
	\begin{syntax}
	simulate (\var{process-tags})
	\end{syntax}
	Generate an event sample. The command allows for analyzing the generated
	events by the \ttt{analysis} expression. Furthermore, events can be written
	to file in various formats. Optionally, the partonic events can be showered
	and hadronized, partly using included external (\pythia) or truly
	external programs called by \whizard. Example:
	\begin{code}
	simulate (w_plus_jets) { sample_format = lhef }
	\end{code}
	See Sec.~\ref{sec:simulation} and Chapter~\ref{chap:events}.


	\subsubsection{graph}
	\begin{syntax}
	graph (\var{tag}) = \var{histograms-and-plots}
	\end{syntax}
	Combine existing histograms and plots into a common graph. Also
	useful for pretty-printing single histograms or plots. Example:
	\begin{code}
	graph comparison {
	$title = "$p_T$ distribution for two different values of $m_h$"
	} = hist1 & hist2
	\end{code}
	% $
	See Sec.~\ref{sec:graphs}.


	\subsubsection{write\_analysis}
	\begin{syntax}
	write\_analysis (\var{analysis-objects})
	\end{syntax}
	Writes out data tables for the specified analysis objects (plots,
	graphs, histograms). If the argument is empty or absent, write all
	analysis objects currently available. The tables are
	available for feeding external programs. Example:
	\begin{code}
	write_analysis
	\end{code}
	See Sec.~\ref{sec:analysis}.


	\subsubsection{compile\_analysis}
	\begin{syntax}
	compile\_analysis (\var{analysis-objects})
	\end{syntax}
	Analogous to \ttt{write\_analysis}, but the generated data tables are
	processed by \LaTeX\ and \gamelan, which produces Postscript and PDF
	versions of the displayed data. Example:
	\begin{code}
	compile_analysis
	\end{code}
	See Sec.~\ref{sec:analysis}.



	\section{Control Structures}

	Like any complete programming language, \sindarin\ provides means for
	branching and looping the program flow.

	\subsection{Conditionals}

	\subsubsection{if}
	\begin{syntax}
	if \var{logical\_expression} then \var{statements} \\
	elsif \var{logical\_expression} then \var{statements} \\
	else \var{statements} \\
	endif
	\end{syntax}
	Execute statements conditionally, depending on the value of a logical
	expression. There may be none or multiple \ttt{elsif} branches, and
	the \ttt{else} branch is also optional. Example:
	\begin{code}
	if (sqrts > 2 * mtop) then
	integrate (top_pair_production)
	else
	printf "Top pair production is not possible"
	endif
	\end{code}
	The current \sindarin\ implementation puts some restriction on the
	statements that can appear in a conditional. For instance, process
	definitions must be done unconditionally.

	\subsection{Loops}
	\subsubsection{scan}
	\begin{syntax}
	scan \var{variable} = (\var{value-list}) \{ \var{statements} \}
	\end{syntax}
	Execute the statements repeatedly, once for each value of the scan
	variable. The statements are executed in a local context, analogous
	to the option statement list for commands. The value list is a
	comma-separated list of expressions, where each item evaluates to the
	value that is assigned to \ttt{\var{variable}} for this iteration.

	The type of the variable is not restricted to numeric, scans can be
	done for various object types. For instance, here is a scan over strings:
	\begin{code}
	scan string $str = ("%.3g", "%.4g", "%.5g") { printf $str (mW) }
	\end{code}
	% $
	The output:
	\begin{interaction}
	[user variable] $str = "%.3g"
	80.4
	[user variable] $str = "%.4g"
	80.42
	[user variable] $str = "%.5g"
	80.419
	\end{interaction}
	% $
	For a numeric scan variable in particular, there are iterators that
	implement the usual functionality of \ttt{for} loops. If the scan
	variable is of type integer, an iterator may take one of the forms
	\begin{syntax}
	\var{start-value} \verb\|=>\| \var{end-value} \\
	\var{start-value} \verb\|=>\| \var{end-value} \verb\|/+\| \var{add-step} \\
	\var{start-value} \verb\|=>\| \var{end-value} \verb\|/-\| \var{subtract-step} \\
	\var{start-value} \verb\|=>\| \var{end-value} \verb\|/*\| \var{multiplicator} \\
	\var{start-value} \verb\|=>\| \var{end-value} \verb\|//\| \var{divisor} \\
	\end{syntax}
	The iterator can be put in place of an expression in the
	\ttt{\var{value-list}}. Here is an example:
	\begin{code}
	scan int i = (1, (3 => 5), (10 => 20 /+ 4))
	\end{code}
	which results in the output
	\begin{interaction}
	[user variable] i = 1
	[user variable] i = 3
	[user variable] i = 4
	[user variable] i = 5
	[user variable] i = 10
	[user variable] i = 14
	[user variable] i = 18
	\end{interaction}
	[Note that the \ttt{\var{statements}} part of the scan construct may
	be empty or absent.]

	For real scan variables, there are even more possibilities for iterators:
	\begin{syntax}
	\var{start-value} \verb\|=>\| \var{end-value} \\
	\var{start-value} \verb\|=>\| \var{end-value} \verb\|/+\| \var{add-step} \\
	\var{start-value} \verb\|=>\| \var{end-value} \verb\|/-\| \var{subtract-step} \\
	\var{start-value} \verb\|=>\| \var{end-value} \verb\|/*\| \var{multiplicator} \\
	\var{start-value} \verb\|=>\| \var{end-value} \verb\|//\| \var{divisor} \\
	\var{start-value} \verb\|=>\| \var{end-value} \verb\|/+/\| \var{n-points-linear} \\
	\var{start-value} \verb\|=>\| \var{end-value} \verb\|/*/\| \var{n-points-logarithmic} \\
	\end{syntax}
	The first variant is equivalent to \ttt{/+ 1}. The \ttt{/+} and
	\ttt{/-} operators are intended to add or subtract the given step once
	for each iteration. Since in floating-point arithmetic this would be
	plagued by rounding ambiguities, the actual implementation first
	determines the (integer) number of iterations from the provided step
	value, then recomputes the step so that the iterations are evenly
	spaced with the first and last value included.

	The \ttt{/*} and \ttt{//} operators are analogous. Here, the initial
	value is intended to be multiplied by the step value once for each
	iteration. After determining the integer number of iterations, the
	actual scan values will be evenly spaced on a logarithmic scale.

	Finally, the \ttt{/+/} and \ttt{/*/} operators allow to specify the
	number of iterations (not counting the initial value) directly. The
	\ttt{\var{start-value}} and \ttt{\var{end-value}} are always included,
	and the intermediate values will be evenly spaced on a linear
	(\ttt{/+/}) or logarithmic (\ttt{/*/}) scale.

	Example:
	\begin{code}
	scan real mh = (130 GeV,
	(140 GeV => 160 GeV /+ 5 GeV),
	180 GeV,
	(200 GeV => 1 TeV /*/ 10))
	{ integrate (higgs_decay) }
	\end{code}


	\subsection{Including Files}
	\subsubsection{include}
	\begin{syntax}
	include (\var{file-name})
	\end{syntax}
	Include a \sindarin\ script from the specified file. The contents
	must be complete commands; they are compiled and executed as if they
	were part of the current script. Example:
	\begin{code}
	include ("default_cuts.sin")
	\end{code}





	\section{Expressions}

	\sindarin\ expressions are classified by their types. The
	type of an expression is verified when the script is compiled, before
	it is executed. This provides some safety against simple coding
	errors.

	Within expressions, grouping is done using ordinary brackets \ttt{()}.
	For subevent expressions, use square brackets \ttt{[]}.

	\subsection{Numeric}
	The language supports the classical numeric types
	\begin{itemize}
	\item
	\ttt{int} for integer: machine-default, usually 32 bit;
	\item
	\ttt{real}, usually \emph{double precision} or 64 bit;
	\item
	\ttt{complex}, consisting of real and imaginary part equivalent to a
	\ttt{real} each.
	\end{itemize}
	\sindarin\ supports arithmetic expressions similar to conventional
	languages. In arithmetic expressions, the three numeric types can be
	mixed as appropriate. The computation essentially follows the rules
	for mixed arithmetic in \fortran. The arithmetic operators are
	\verb\|+\|, \verb\|-\|, \verb\|*\|, \verb\|/\|, \verb\|^\|. Standard functions
	such as \ttt{sin}, \ttt{sqrt}, etc. are available. See
	Sec.~\ref{sec:real} to Sec.~\ref{sec:complex}.

	Numeric values can be associated with units. Units evaluate to
	numerical factors, and their use is optional, but they can be useful
	in the physics context for which \whizard\ is designed. Note that the
	default energy/mass unit is \verb\|GeV\|, and the default unit for cross
	sections is \verb\|fbarn\|.


	\subsection{Logical and String}

	The language also has the following standard types:
	\begin{itemize}
	\item
	\ttt{logical} (a.k.a.\ boolean). Logical variable names have a
	\ttt{?} (question mark) as prefix.
	\item
	\ttt{string} (arbitrary length). String variable names have a \ttt{\$}
	(dollar) sign as prefix.
	\end{itemize}
	There are comparisons, logical operations, string concatenation, and a
	mechanism for formatting objects as strings for output.


	\subsection{Special}

	Furthermore, \sindarin\ deals with a bunch of data types tailored
	specifically for Monte Carlo applications:
	\begin{itemize}
	\item
	\ttt{alias} objects denote a set of particle species.
	\item
	\ttt{subevt} objects denote a collection of particle momenta within an
	event. They have their uses in cut and analysis expressions.
	\item
	\ttt{process} object are generated by a \ttt{process} statement.
	There are no expressions involving processes, but they are referred
	to by \ttt{integrate} and \ttt{simulate} commands.
	\item
	\ttt{model}: There is always a current object of type and name
	\ttt{model}. Several models can be used concurrently by
	appropriately defining processes, but this happens behind the scenes.
	\item
	\ttt{beams}: Similarly, the current implementation allows only for a single
	object of this type at a given time, which is assigned by a \ttt{beams =}
	statement and used by \ttt{integrate}.
	\end{itemize}

	In the current implementation, \sindarin\ has no container data types
	derived from basic types, such as lists, arrays, or hashes, and there
	are no user-defined data types. (The \ttt{subevt} type is a container
	for particles in the context of events, but there is no type for an
	individual particle: this is represented as a one-particle
	\ttt{subevt}). There are also containers for inclusive processes which
	are however simply handled as an expansion into several components of
	a master process tag.





	\section{Variables}
	\label{sec:variables}

	\sindarin\ supports global variables, variables local to a scoping unit (the
	option body of a command, the body of a \ttt{scan} loop), and variables local
	to an expression.

	Some variables are predefined by the system (\emph{intrinsic
	variables}). They are further separated into \emph{independent}
	variables that can be reset by the user, and \emph{derived} or locked
	variables that are automatically computed by the program, but not
	directly user-modifiable. On top of that, the user is free to
	introduce his own variables (\emph{user variables}).

	The names of numerical variables consist of alphanumeric characters and
	underscores. The first character must not be a digit. Logical
	variable names are furthermore prefixed by a
	\ttt{?} (question mark) sign, while string variable names begin
	with a \ttt{\$} (dollar) sign.

	Character case does matter. In this manual we follow the
	convention that variable names consist of lower-case letters,
	digits, and underscores only, but you may also use upper-case
	letters if you wish.

	Physics models contain their own, specific set of numeric variables
	(masses, couplings). They are attached to the model where they are
	defined, so they appear and disappear with the model that is currently
	loaded. In particular, if two different models contain a variable
	with the same name, these two variables are nevertheless distinct:
	setting one doesn't affect the other. This feature might be called,
	in computer-science jargon, a \emph{mixin}.

	User variables -- global or local -- are declared by their type when they are
	introduced, and acquire an initial value upon declaration. Examples:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	int i = 3
	real my_cut_value = 10 GeV
	complex c = 3 - 4 * I
	logical ?top_decay_allowed = mH > 2 * mtop
	string $hello = "Hello world!"
	alias q = d:u:s:c
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	An existing user variable can be assigned a new value without a declaration:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	i = i + 1
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	and it may also be redeclared if the new declaration specifies the same type,
	this is equivalent to assigning a new value.

	Variables local to an expression are introduced by the \ttt{let ... in}
	contruct. Example:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	real a = let int n = 2 in
	x^n + y^n
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	The explicit \ttt{int} declaration is necessary only if the variable \ttt{n}
	has not been declared before. An intrinsic variable must not be declared:
	\ttt{let mtop = 175.3 GeV in \ldots}

	\ttt{let} constructs can be concatenated if several local variables need to
	be assigned: \ttt{let a = 3 in let b = 4 in \textit{expression}}.

	Variables of type \ttt{subevt} can only be defined in \ttt{let} constructs.

	Exclusively in the context of particle selections (event analysis), there are
	\emph{observables} as special numeric objects. They are used like numeric
	variables, but they are never declared or assigned. They get their value
	assigned dynamically, computed from the particle momentum configuration.
	Hence, they may be understood as (intrinsic and predefined) macros.
	By convention, observable names begin with a capital letter.

	Further macros are
	\begin{itemize}
	\item
	\ttt{cuts} and \ttt{analysis}. They are of type logical, and can be
	assigned an expression by the user. They are evaluated once for
	each event.
	\item
	\ttt{scale}, \ttt{factorization\_scale} and
	\ttt{renormalization\_scale} are real numeric macros which define the
	energy scale(s) of an event. The latter two override the former.
	If no scale is defined, the partonic energy is used as the process scale.
	\item
	\ttt{weight} is a real numeric macro. If it is assigned an
	expression, the expression is evaluated for each valid phase-space
	point, and the result multiplies the matrix element.
	\end{itemize}

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{\sindarin\ in Details}
	\label{chap:sindarin}

	\section{Data and expressions}

	\subsection{Real-valued objects}
	\label{sec:real}

	Real literals have their usual form, mantissa and, optionally, exponent:
	\begin{center}
	\ttt{0.}\quad \ttt{3.14}\quad \ttt{-.5}\quad
	\ttt{2.345e-3}\quad \ttt{.890E-023}
	\end{center}
	Internally, real values are treated as double precision. The values are read
	by the \fortran\ library, so details depend on its implementation.

	A special feature of \sindarin\ is that numerics (real and integer) can be
	immediately followed by a physical unit. The supported units are presently
	hard-coded, they are
	\begin{center}
	\ttt{meV}\quad \ttt{eV}\quad \ttt{keV}\quad
	\ttt{MeV}\quad \ttt{GeV}\quad \ttt{TeV}
	\\
	\ttt{nbarn}\quad \ttt{pbarn}\quad \ttt{fbarn}\quad \ttt{abarn}
	\\
	\ttt{rad}\quad \ttt{mrad}\quad \ttt{degree}
	\\
	\ttt{\%}
	\end{center}
	If a number is followed by a unit, it is automatically normalized to the
	corresponding default unit: \ttt{14.TeV} is transformed into the real number
	\ttt{14000.} Default units are \ttt{GeV}, \ttt{fbarn}, and \ttt{rad}. The
	\ttt{\%} sign after a number has the effect that the number is multiplied by
	$0.01$. Note that no checks for consistency of units are done, so you can add
	\ttt{1 meV + 3 abarn} if you absolutely wish to. Omitting units is always
	allowed, in that case, the default unit is assumed.

	Units are not treated as variables. In particular, you can't write \ttt{theta
	/ degree}, the correct form is \ttt{theta / 1 degree}.

	There is a single predefined real constant, namely $\pi$ which is referred to
	by the keyword \ttt{pi}. In addition, there is a single predefined
	complex constant, which is the complex unit $i$, being referred to by
	the keyword \ttt{I}.

	The arithmetic operators are
	\begin{center}
	\verb\|+\| \verb\|-\| \verb\|*\| \verb\|/\| \verb\|^\|
	\end{center}
	with their obvious meaning and the usual precedence rules.

	\sindarin\ supports a bunch of standard numerical functions, mostly equivalent
	to their \fortran\ counterparts:
	\begin{center}
	\ttt{abs}\quad \ttt{conjg}\quad \ttt{sgn}\quad \ttt{mod}\quad \ttt{modulo}
	\\
	\ttt{sqrt}\quad \ttt{exp}\quad \ttt{log}\quad \ttt{log10}
	\\
	\ttt{sin}\quad \ttt{cos}\quad \ttt{tan}\quad
	\ttt{asin}\quad \ttt{acos}\quad \ttt{atan}
	\\
	\ttt{sinh}\quad \ttt{cosh}\quad \ttt{tanh}
	\end{center}
	(Unlike \fortran, the \ttt{sgn} function takes only one argument and returns
	$1.$, or $-1.$) The function argument is enclosed in brackets: \ttt{sqrt
	(2.)}, \ttt{tan (11.5 degree)}.

	There are two functions with two real arguments:
	\begin{center}
	\ttt{max}\quad \ttt{min}
	\end{center}
	Example: \verb\|real lighter_mass = min (mZ, mH)\|

	The following functions of a real convert to integer:
	\begin{center}
	\ttt{int}\quad \ttt{nint}\quad \ttt{floor}\quad \ttt{ceiling} %% \; .
	\end{center}
	and this converts to complex type:
	\begin{center}
	\ttt{complex}
	\end{center}

	Real values can be compared by the following operators, the result is a
	logical value:
	\begin{center}
	\verb\|==\|\quad \verb\|<>\|
	\\
	\verb\|>\|\quad \verb\|<\|\quad \verb\|>=\|\quad \verb\|<=\|
	\end{center}
	In \sindarin, it is possible to have more than two operands in a logical
	expressions. The comparisons are done from left to right. Hence,
	\begin{center}
	\verb\|115 GeV < mH < 180 GeV\|
	\end{center}
	is valid \sindarin\ code and evaluates to \ttt{true} if the Higgs mass is in the
	given range.

	Tests for equality and inequality with machine-precision real numbers are
	notoriously unreliable and should be avoided altogether. To deal with this
	problem, \sindarin\ has the possibility to make the comparison operators
	``fuzzy'' which should be read as ``equal (unequal) up to an absolute
	tolerance'', where the tolerance is given by the real-valued intrinsic
	variable \ttt{tolerance}. This variable is initially zero, but can be
	set to any value (for instance, \ttt{tolerance = 1.e-13} by the user.
	Note that for non-zero tolerance, operators like
	\verb\|==\| and \verb\|<>\| or \verb\|<\| and \verb\|>\| are not mutually
	exclusive\footnote{In older versions of \whizard, until v2.1.1, there
	used to be separate comparators for the comparisons up to a tolerance,
	namely \ttt{==\~{}} and \ttt{<>\~{}}. These have been discarded from
	v2.2.0 on in order to simplify the syntax.}.

	%%%%%%%%%%%%%%%

	\subsection{Integer-valued objects}
	\label{sec:integer}

	Integer literals are obvious:
	\begin{center}
	\ttt{1}\quad \ttt{-98765}\quad \ttt{0123}
	\end{center}
	Integers are always signed. Their range is the default-integer range as
	determined by the \fortran\ compiler.

	Like real values, integer values can be followed by a physical unit: \ttt{1
	TeV}, \ttt{30 degree}. This actually transforms the integer into a real.

	Standard arithmetics is supported:
	\begin{center}
	\verb\|+\| \verb\|-\| \verb\|*\| \verb\|/\| \verb\|^\|
	\end{center}
	It is important to note that there is no fraction datatype, and pure integer
	arithmetics does not convert to real. Hence \ttt{3/4} evaluates to \ttt{0},
	but \ttt{3 GeV / 4 GeV} evaluates to \ttt{0.75}.

	Since all arithmetics is handled by the underlying \fortran\ library, integer
	overflow is not detected. If in doubt, do real arithmetics.

	Integer functions are more restricted than real functions. We support the
	following:
	\begin{center}
	\ttt{abs}\quad \ttt{sgn}\quad \ttt{mod}\quad \ttt{modulo}
	\\
	\ttt{max}\quad \ttt{min}
	\end{center}
	and the conversion functions
	\begin{center}
	\ttt{real}\quad \ttt{complex}
	\end{center}
	Comparisons of integers among themselves and with reals are possible using the
	same set of comparison operators as for real values. This includes
	the operators with a finite tolerance.

	%%%%%%%%%%%%%%%%

	\subsection{Complex-valued objects}
	\label{sec:complex}

	Complex variables and values are currently not yet used by the physics
	models implemented in \whizard. There complex input coupling constants
	are always split into their real and imaginary parts (or modulus and
	phase). They are exclusively available for arithmetic calculations.

	There is no form for complex literals. Complex values must be created via an
	arithmetic expression,
	\begin{center}
	\ttt{complex c = 1 + 2 * I}
	\end{center}
	where the imaginary unit \ttt{I} is predefined as a constant.

	The standard arithmetic operations are supported (also mixed with real and
	integer). Support for functions is currently still incomplete, among the
	supported functions there are \ttt{sqrt}, \ttt{log}, \ttt{exp}.



	\subsection{Logical-valued objects}

	There are two predefined logical constants, \ttt{true} and \ttt{false}.
	Logicals are \emph{not} equivalent to integers (like in C) or to strings (like
	in PERL), but they make up a type of their own. Only in \verb\|printf\| output,
	they are treated as strings, that is, they require the \verb\|%s\| conversion
	specifier.

	The names of logical variables begin with a question mark \ttt{?}. Here is
	the declaration of a logical user variable:
	\begin{quote}
	\begin{footnotesize}
	\begin{footnotesize}
	\begin{verbatim}
	logical ?higgs_decays_into_tt = mH > 2 * mtop
	\end{verbatim}
	\end{footnotesize}
	\end{footnotesize}
	\end{quote}

	Logical expressions use the standard boolean operations
	\begin{center}
	\ttt{or}\quad \ttt{and}\quad \ttt{not}
	\end{center}
	The results of comparisons (see above) are logicals.

	There is also a special logical operator with lower priority, concatenation by
	a semicolon:
	\begin{center}
	\ttt{\textit{lexpr1} ; \textit{lexpr2}}
	\end{center}
	This evaluates \textit{lexpr1} and throws its result away, then evaluates
	\textit{lexpr2} and returns that result. This feature is to used with logical
	expressions that have a side effect, namely the \ttt{record} function within
	analysis expressions.

	The primary use for intrinsic logicals are flags that change the behavior of
	commands. For instance, \ttt{?unweighted = true} and \ttt{?unweighted =
	false} switch the unweighting of simulated event samples on and off.


	\subsection{String-valued objects and string operations}
	\label{sec:sprintf}

	String literals are enclosed in double quotes: \ttt{"This is a string."}
	The empty string is \ttt{""}. String variables begin with the dollar
	sign: \verb\|$\|. There is only one string operation, concatenation
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	string $foo = "abc" & "def"
	\end{verbatim}
	\end{footnotesize}
	\end{quote}

	However, it is possible to transform variables and values to a string using
	the \ttt{sprintf} function. This function is an interface to the system's \ttt{C}
	function \ttt{sprintf} with some restrictions and modifications. The allowed
	conversion specifiers are
	\begin{center}
	\verb\|%d\|\quad \verb\|%i\| (integer)
	\\
	\verb\|%e\|\quad \verb\|%f\|\quad \verb\|%g\|\quad
	\verb\|%E\|\quad \verb\|%F\|\quad \verb\|%G\| (real)
	\\
	\verb\|%s\| (string and logical)
	\end{center}
	The conversions can use flag parameter, field width, and precision, but length
	modifiers are not supported since they have no meaning for the application.
	(See also Sec.~\ref{sec:I/O}.)

	The \ttt{sprintf} function has the syntax
	\begin{center}
	\ttt{sprintf} \textit{format-string}
	\ttt{(}\textit{arg-list}\ttt{)}
	\end{center}
	This is an expression that evaluates to a string. The format string contains
	the mentioned conversion specifiers. The argument list is optional. The
	arguments are separated by commas. Allowed arguments are integer, real,
	logical, and string variables, and numeric expressions. Logical and string
	expressions can also be printed, but they have to be dressed as
	\emph{anonymous variables}. A logical anonymous variable has the form
	\ttt{?(}\textit{logical\_expr}\ttt{)} (example: \ttt{?(mH > 115 GeV)}). A
	string anonymous variable has the form \ttt{\$(}\textit{string-expr}\ttt{)}.

	Example:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	string $unit = "GeV"
	string $str = sprintf "mW = %f %s" (mW, $unit)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	The related \ttt{printf} command with the same syntax prints the formatted
	string to standard output\footnote{In older versions of \whizard,
	until v2.1.1, there also used to be a \ttt{sprintd} function and a
	\ttt{printd} command for default formats without a format
	string. They have been discarded in order to simplify the syntax
	from version v2.2.0 on.}.


	\section{Particles and (sub)events}

	\subsection{Particle aliases}
	\label{sec:alias}

	A particle species is denoted by its name as a string: \verb\|"W+"\|.
	Alternatively, it can be addressed by an \ttt{alias}. For instance, the $W^+$
	boson has the alias \ttt{Wp}. Aliases are used like variables in a context
	where a particle species is expected, and the user can specify his/her own
	aliases.

	An alias may either denote a single particle species or a class of particles
	species. A colon \ttt{:} concatenates particle names and aliases to yield
	multi-species aliases:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	alias quark = u:d:s
	alias wboson = "W+":"W-"
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Such aliases are used for defining processes with summation over flavors, and
	for defining classes of particles for analysis.

	Each model files define both names and (single-particle) aliases for all
	particles it contains. Furthermore, it defines the class aliases
	\verb\|colored\| and \verb\|charged\| which are particularly useful for event
	analysis.


	\subsection{Subevents}

	Subevents are sets of particles, extracted from an event. The sets are
	unordered by default, but may be ordered by appropriate functions. Obviously,
	subevents are meaningful only in a context where an event is available. The
	possible context may be the specification of a cut, weight, scale, or analysis
	expression.

	To construct a simple subevent, we put a particle alias or an expression of
	type particle alias into square brackets:
	\begin{quote}
	\begin{footnotesize}
	\verb\|["W+"]\|\quad
	\verb\|[u:d:s]\|\quad
	\verb\|[colored]\|
	\end{footnotesize}
	\end{quote}
	These subevents evaluate to the set of all $W^+$ bosons (to be precise, their
	four-momenta), all $u$, $d$, or $s$ quarks, and all colored particles,
	respectively.

	A subevent can contain pseudoparticles, i.e., particle combinations.
	That is, the four-momenta of
	distinct particles are combined (added conmponent-wise), and the results
	become subevent elements just like ordinary particles.

	The (pseudo)particles in a subevent are non-overlapping. That is, for
	any of the particles in the original event, there is at most one
	(pseudo)particle in the subevent in which it is contained.

	Sometimes, variables (actually, named constants) of type subevent are useful.
	Subevent variables are declared by the \ttt{subevt} keyword, and their
	names carry the prefix \verb\|@\|. Subevent variables exist only within the
	scope of a \verb\|cuts\| (or \verb\|scale\|, \verb\|analysis\|, etc.) macro, which
	is evaluated in the presence of an actual event. In the macro body, they are
	assigned via the \ttt{let} construct:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	cuts =
	let subevt @jets = select if Pt > 10 GeV [colored]
	in
	all Theta > 10 degree [@jets, @jets]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	In this expression, we first define \verb\|@jets\| to stand for the set of all
	colored partons with $p_T>10\;\mathrm{GeV}$. This abbreviation is then used
	in a logical expression, which evaluates to true if all relative angles
	between distinct jets are greater than $10$ degree.

	We note that the example also introduces pairs of subevents: the square
	bracket with two entries evaluates to the list of all possible pairs which do
	not overlap. The objects within square brackets can be either subevents or
	alias expressions. The latter are transformed into subevents before they are
	used.

	As a special case, the original event is always available as the predefined
	subevent \verb\|@evt\|.

	\subsection{Subevent functions}

	There are several functions that take a subevent (or an alias) as an argument
	and return a new subevent. Here we describe them:

	\subsubsection{collect}
	\begin{quote}
	\begin{footnotesize}
	\ttt{collect [\textit{particles}]} \\
	\ttt{collect if \textit{condition} [\textit{particles}]} \\
	\ttt{collect if \textit{condition} [\textit{particles}, \textit{ref\_particles}]}
	\end{footnotesize}
	\end{quote}
	First version: collect all particle momenta in the argument and combine them
	to a single four-momentum. The \textit{particles} argument may either be a
	\ttt{subevt} expression or an \ttt{alias} expression. The result is a
	one-entry \ttt{subevt}. In the second form, only those particles are collected
	which satisfy the \textit{condition}, a logical expression. Example:
	\ttt{collect if Pt > 10 GeV [colored]}

	The third version is useful if you want to put binary observables (i.e.,
	observables constructed from two different particles) in the condition. The
	\textit{ref\_particles} provide the second argument for binary observables in
	the \textit{condition}. A particle is taken into account if the condition is
	true with respect to all reference particles that do not overlap with this
	particle. Example: \ttt{collect if Theta > 5 degree [photon, charged]}:
	combine all photons that are separated by 5 degrees from all charged
	particles.


	\subsubsection{cluster}

	\begin{quote}
	\begin{footnotesize}
	\ttt{cluster [\textit{particles}]} \\
	\ttt{cluster if \textit{condition} [\textit{particles}]} \\
	\end{footnotesize}
	\end{quote}
	First version: collect all particle momenta in the argument and cluster them
	to a set of jets. The \textit{particles} argument may either be a
	\ttt{subevt} expression or an \ttt{alias} expression. The result is a
	one-entry \ttt{subevt}. In the second form, only those particles are clustered
	which satisfy the \textit{condition}, a logical expression. Example:
	\ttt{cluster if Pt > 10 GeV [colored]}

	% The third version is usefule if you want to put binary observables (i.e.,
	% observables constructed from two different particles) in the condition. The
	% \textit{ref\_particles} provide the second argument for binary observables in
	% the \textit{condition}. A particle is taken into account if the condition is
	% true with respect to all reference particles that do not overlap with this
	% particle. Example: \ttt{cluster if Theta > 5 degree [photon, charged]}:
	% combine all photons that are separated by 5 degrees from all charged
	% particles.

	This command is available from \whizard\ version 2.2.1 on, and only if
	the \fastjet\ package has been installed and linked with \whizard\
	(cf. Sec.\ref{sec:fastjet}); in a future version of \whizard\ it is
	foreseen to have also an intrinsic clustering package inside \whizard\
	which will be able to support some of the clustering algorithms
	below. To use it in an analysis, you have to set the variable
	\ttt{jet\_algorithm} to one of the predefined jet-algorithm values
	(integer constants):
	\begin{quote}
	\begin{footnotesize}
	\ttt{kt\_algorithm}\\
	\ttt{cambridge\_algorithm}\\
	\ttt{antikt\_algorithm}\\
	\ttt{genkt\_algorithm}\\
	\ttt{cambridge\_for\_passive\_algorithm}\\
	\ttt{genkt\_for\_passive\_algorithm}\\
	\ttt{ee\_kt\_algorithm}\\
	\ttt{ee\_genkt\_algorithm}\\
	\ttt{plugin\_algorithm}
	\end{footnotesize}
	\end{quote}
	and the variable \ttt{jet\_r} to the desired $R$ parameter value, as
	appropriate for the analysis and the jet algorithm. Example:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	jet_algorithm = antikt_algorithm
	jet_r = 0.7
	cuts = all Pt > 15 GeV [cluster if Pt > 5 GeV [colored]]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}

	\subsubsection{select\_b\_jet, select\_non\_b\_jet, select\_c\_jet,
	select\_light\_jet}

	This command is available from \whizard\ version 2.8.1 on, and it only
	generates anything non-trivial if the \fastjet\ package has been
	installed and linked with \whizard\ (cf. Sec.\ref{sec:fastjet}). It
	only returns sensible results when it is applied to subevents after
	the \ttt{cluster} command (cf. the paragraph before). It is similar to
	the \ttt{select} command, and accepts a logical expression as a
	possible condition. The four commands \ttt{select\_b\_jet},
	\ttt{select\_non\_b\_jet}, \ttt{select\_c\_jet}, and
	\ttt{select\_light\_jet} select $b$ jets, non-$b$ jets
	(anything lighter than $b$s), $c$ jets (neither $b$ nor light) and
	light jets (anything besides $b$ and $c$), respectively. An example
	looks like this:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	alias lightjet = u:U:d:D:s:S:c:C:gl
	alias jet = b:B:lightjet
	process eebbjj = e1, E1 => b, B, lightjet, lightjet
	jet_algorithm = antikt_algorithm
	jet_r = 0.5
	cuts = let subevt @clustered_jets = cluster [jet] in
	let subevt @bjets = select_b_jet [@clustered_jets] in
	....
	\end{verbatim}
	\end{footnotesize}
	\end{quote}

	\subsubsection{photon\_isolation}

	This command is available from \whizard\ version 2.8.1 on. It provides
	isolation of photons from hadronic (and possibly electromagnetic)
	activity in the event to define a (especially) NLO cross section that
	is completely perturbative. The isolation criterion according to
	Frixione, cf.~\cite{Frixione:1998jh}, removes the non-perturbative
	contribution from the photon fragmentation function. This command can
	in principle be applied to elementary hard process partons (and
	leptons), but generates something sensible only if the
	\fastjet\ package has been installed and linked with
	\whizard\ (cf. Sec.\ref{sec:fastjet}). There are three parameters
	which allow to tune the isolation, \ttt{photon\_iso\_r0}, which is the
	radius $R^0_\gamma$ of the isolation cone, \ttt{photon\_iso\_eps},
	which is the fraction $\epsilon_\gamma$ of the photon (transverse)
	energy that enters the isolation criterion, and the exponent of the
	isolation cone, \ttt{photon\_iso\_n}, $n^\gamma$. For more information
	cf.~\cite{Frixione:1998jh}. The command allows also a conditional cut
	on the photon which is applied before the isolation takes place. The
	first argument are the photons in the event, the second the particles
	from which they should be isolated. If also the electromagnetic
	activity is to be isolated, photons need to be isolated from
	themselves and must be included in the second argument. This is
	mandatory if leptons appear in the second argument. Two examples look
	like this:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	alias jet = u:U:d:D:s:S:c:C:gl
	process eeaajj = e1, E1 => A, A, jet, jet
	jet_algorithm = antikt_algorithm
	jet_r = 0.5
	cuts = photon_isolation if Pt > 10 GeV [A, jet]
	....
	cuts = let subevt @jets = cluster [jet] in
	photon_isolation if Pt > 10 GeV [A, @jets]
	....
	process eeajmm = e1, E1 => A, jet, e2, E2
	cuts = let subevt @jets = cluster [jet] in
	let subevt @iso = join [@jets, A:e2:E2]
	photon_isolation [A, @iso]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}

	\subsubsection{photon\_recombination}
	\begin{quote}
	\begin{footnotesize}
	\ttt{photon\_recombination [\textit{particles}]} \\
	\ttt{photon\_recombination if \textit{condition} [\textit{particles}]}
	\end{footnotesize}
	\end{quote}
	This function, which maps a subevent into another subevent, is used for
	electroweak (and mixed coupling) higher order calculations. It takes
	the selection of photons in \texttt{particles} (for the moment,
	\whizard\ restricts this to one explicit photon in the final state)
	and recombines it with the closest non-photon particle from
	\texttt{particles} in $R$-distance, if the $R$-distance is smaller
	than the parameter set by \texttt{photon\_rec\_r0}.
	Otherwise the \texttt{particles} subevent is left unchanged so
	that it may contain possibly non-recombined photons.
	The logical variable \texttt{?keep\_flavors\_when\_recombining}
	determines whether \whizard\ keeps the flavor of the particle with
	which the photon is recombined into the pseudoparticle, the default
	being \texttt{true}.
	An example for photon recombination is shown here:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	alias lep = e1:e2:e3:E1:E2:E3
	process eevv = e1, E1 => A, lep, lep, lep, lep
	photon_rec_r0 = 0.15
	cuts = let subevt @reco =
	photon_recombination if abs (Eta) < 2.5 [A:lep] in
	....
	\end{verbatim}
	\end{footnotesize}
	\end{quote}


	\subsubsection{combine}
	\begin{quote}
	\begin{footnotesize}
	\ttt{combine [\textit{particles\_1}, \textit{particles\_2}]} \\
	\ttt{combine if \textit{condition} [\textit{particles\_1}, \textit{particles\_2}]}
	\end{footnotesize}
	\end{quote}
	Make a new subevent of composite particles. The composites are generated by
	combining all particles from subevent \textit{particles\_1} with all particles
	from subevent \textit{particles\_2} in all possible combinations. Overlapping
	combinations are excluded, however: if a (composite) particle in the first
	argument has a constituent in common with a composite particle in the second
	argument, the combination is dropped. In particular, this applies if the
	particles are identical.

	If a \textit{condition} is provided, the combination is done only when the
	logical expression, applied to the particle pair in question, returns true.
	For instance, here we reconstruct intermediate $W^-$ bosons:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	let @W_candidates = combine if 70 GeV < M < 80 GeV ["mu-", "numubar"]
	in ...
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Note that the combination may fail, so the resulting subevent could be empty.


	\subsubsection{operator +}

	If there is no condition, the $+$ operator provides a convenient
	shorthand for the \verb\|combine\| command. In particular, it can be
	used if there are several particles to combine. Example:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	cuts = any 170 GeV < M < 180 GeV [b + lepton + invisible]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}


	\subsubsection{select}
	\begin{quote}
	\begin{footnotesize}
	\ttt{select if \textit{condition} [\textit{particles}]} \\
	\ttt{select if \textit{condition} [\textit{particles}, \textit{ref\_particles}]}
	\end{footnotesize}
	\end{quote}
	One argument: select all particles in the argument that satisfy the
	\textit{condition} and drop the rest. Two arguments: the
	\textit{ref\_particles} provide a second argument for binary observables.
	Select particles if the condition is satisfied for all reference particles.

	\subsubsection{extract}
	\begin{quote}
	\begin{footnotesize}
	\ttt{extract [\textit{particles}]} \\
	\ttt{extract index \textit{index-value} [\textit{particles}]}
	\end{footnotesize}
	\end{quote}
	Return a single-particle subevent. In the first version, it contains the
	first particle in the subevent \textit{particles}. In the second version, the
	particle with index \textit{index-value} is returned, where
	\textit{index-value} is an integer expression. If its value is negative, the
	index is counted from the end of the subevent.

	The order of particles in an event or subevent is not always well-defined, so
	you may wish to sort the subevent before applying the \textit{extract}
	function to it.

	\subsubsection{sort}
	\begin{quote}
	\begin{footnotesize}
	\ttt{sort [\textit{particles}]} \\
	\ttt{sort by \textit{observable} [\textit{particles}]} \\
	\ttt{sort by \textit{observable} [\textit{particles}, \textit{ref\_particle}]}
	\end{footnotesize}
	\end{quote}
	Sort the subevent according to some criterion. If no criterion is supplied
	(first version), the subevent is sorted by increasing PDG code (first
	particles, then antiparticles). In the second version, the
	\textit{observable} is a real expression which is evaluated for each particle
	of the subevent in turn. The subevent is sorted by increasing value of this
	expression, for instance:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	let @sorted_evt = sort by Pt [@evt]
	in ...
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	In the third version, a reference particle is provided as second argument, so
	the sorting can be done for binary observables. It doesn't make much sense to
	have several reference particles at once, so the \ttt{sort} function uses
	only the first entry in the subevent \textit{ref-particle}, if it has more
	than one.


	\subsubsection{join}
	\begin{quote}
	\begin{footnotesize}
	\ttt{join [\textit{particles}, \textit{new\_particles}]} \\
	\ttt{join if \textit{condition} [\textit{particles}, \textit{new\_particles}]}
	\end{footnotesize}
	\end{quote}
	This commands appends the particles in subevent \textit{new\_particles} to the
	subevent \textit{particles}, i.e., it joins the two particle sets. To be
	precise, a (pseudo)particle from \textit{new\_particles} is only appended if it
	does not overlap with any of the (pseudo)particles
	present in \textit{particles}, so the function will not produce overlapping
	entries.

	In the second version, each particle from \textit{new\_particles} is also
	checked with all particles in the first set whether \textit{condition} is
	fulfilled. If yes, and there is no overlap, it is appended, otherwise
	it is dropped.


	\subsubsection{operator \&}

	Subevents can also be concatenated by the operator \verb\|&\|. This effectively
	applies \ttt{join} to all operands in turn. Example:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	let @visible =
	select if Pt > 10 GeV and E > 5 GeV [photon]
	& select if Pt > 20 GeV and E > 10 GeV [colored]
	& select if Pt > 10 GeV [lepton]
	in ...
	\end{verbatim}
	\end{footnotesize}
	\end{quote}


	\subsection{Calculating observables}

	Observables (invariant mass \ttt{M}, energy \ttt{E}, \ldots) are used in
	expressions just like ordinary numeric variables. By convention, their names
	start with a capital letter. They are computed using a particle
	momentum (unary observables), or two particle momenta (binary
	observables) or all momenta of the particles (n-ary/subeventary
	observables) which are taken from a subsequent subevent argument.

	We can extract the value of an observable for an event and make it available
	for computing the \ttt{scale} value, or for histogramming etc.:

	\subsubsection{eval}
	\begin{quote}
	\begin{footnotesize}
	\ttt{eval \textit{expr} [\textit{particles}]} \\
	\ttt{eval \textit{expr} [\textit{particles\_1}, \textit{particles\_2}]}
	\end{footnotesize}
	\end{quote}

	The function \ttt{eval} takes an expression involving observables and
	evaluates it for the first momentum (or momentum pair) of the subevent (or
	subevent pair) in square brackets that follows the expression. For example,
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	eval Pt [colored]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	evaluates to the transverse momentum of the first colored particle,
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	eval M [@jets, @jets]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	evaluates to the invariant mass of the first distinct pair of jets (assuming
	that \verb\|@jets\| has been defined in a \ttt{let} construct), and
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	eval E - M [combine [e1, N1]]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	evaluates to the difference of energy and mass of the combination of the first
	electron-neutrino pair in the event.

	The last example illustrates why observables are treated like variables, even
	though they are functions of particles: the \ttt{eval} construct with the
	particle reference in square brackets after the expression allows to compute
	derived observables -- observables which are functions of new observables --
	without the need for hard-coding them as new functions.

	For subeventary observables, e.g. \ttt{Ht}, the momenta of all
	particles in the subevent are taken to evaluate the observables, e.g.
	\begin{quote}
	\begin{verbatim}
	eval Ht/2 [t:T:Z:jet]
	\end{verbatim}
	\end{quote}
	takes the (half of) the transverse mass of all tops, $Z$s and jets in
	the final state.


	\subsubsection{sum}

	This \sindarin\ statement works similar to the \ttt{eval} statement
	above, with the syntax
	\begin{quote}
	\begin{verbatim}
	sum <expr> [<subevt>]
	\end{verbatim}
	\end{quote}
	It sums the \ttt{<expr>} over all elements of the subevents
	\ttt{<subevt>}, e.g.
	\begin{quote}
	\begin{verbatim}
	sum sqrt(Pt^2 + M^2)/2 [t:T:H:Z]
	\end{verbatim}
	\end{quote}
	would calculate the transverse mass (square root of the sum of squared
	transverse momentum and squared mass) of all tops, Higgs and $Z$
	bosons in the final state.

	\subsubsection{prod}

	Identical to \ttt{sum}, but takes the product, not the sum of the
	expression \ttt{<expr>} evaluated over the full subevent. Syntax:
	\begin{quote}
	\begin{verbatim}
	prod <expr> [<subevt>]
	\end{verbatim}
	\end{quote}

	\subsection{Cuts and event selection}
	\label{sec:cuts}

	Instead of a numeric value, we can use observables to compute a logical value.

	\subsubsection{all}
	\begin{quote}
	\begin{footnotesize}
	\ttt{all \textit{logical\_expr} [\textit{particles}]} \\
	\ttt{all \textit{logical\_expr} [\textit{particles\_1}, \textit{particles\_2}]}
	\end{footnotesize}
	\end{quote}
	The \ttt{all} construct expects a logical expression and one or two subevent
	arguments in square brackets.
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	all Pt > 10 GeV [charged]
	all 80 GeV < M < 100 GeV [lepton, antilepton]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	In the second example, \ttt{lepton} and \ttt{antilepton} should be aliases
	defined in a \ttt{let} construct. (Recall that aliases are promoted to
	subevents if they occur within square brackets.)

	This construction defines a cut. The result value is \ttt{true} if the
	logical expression evaluates to \ttt{true} for all particles in the subevent
	in square brackets. In the two-argument case it must be \ttt{true} for all
	non-overlapping combinations of particles in the two subevents. If one of the
	arguments is the empty subevent, the result is also \ttt{true}.

	\subsubsection{any}
	\begin{quote}
	\begin{footnotesize}
	\ttt{any \textit{logical\_expr} [\textit{particles}]} \\
	\ttt{any \textit{logical\_expr} [\textit{particles\_1}, \textit{particles\_2}]}
	\end{footnotesize}
	\end{quote}
	The \ttt{any} construct is true if the logical expression is true for at least
	one particle or non-overlapping particle combination:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	any E > 100 GeV [photon]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This defines a trigger or selection condition. If a subevent argument is
	empty, it evaluates to \ttt{false}

	\subsubsection{no}
	\begin{quote}
	\begin{footnotesize}
	\ttt{no \textit{logical\_expr} [\textit{particles}]} \\
	\ttt{no \textit{logical\_expr} [\textit{particles\_1}, \textit{particles\_2}]}
	\end{footnotesize}
	\end{quote}
	The \ttt{no} construct is true if the logical expression is true for no single
	one particle or non-overlapping particle combination:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	no 5 degree < Theta < 175 degree ["e-":"e+"]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This defines a veto condition. If a subevent argument is empty, it
	evaluates to \ttt{true}. It is equivalent to \ttt{not any\ldots}, but
	included for notational convenience.


	\subsection{More particle functions}

	\subsubsection{count}
	\begin{quote}
	\begin{footnotesize}
	\ttt{count [\textit{particles}]} \\
	\ttt{count [\textit{particles\_1}, \textit{particles\_2}]} \\
	\ttt{count if \textit{logical-expr} [\textit{particles}]} \\
	\ttt{count if \textit{logical-expr} [\textit{particles}, \textit{ref\_particles}]}
	\end{footnotesize}
	\end{quote}
	This counts the number of events in a subevent, the result is of type
	\ttt{int}. If there is a conditional expression, it counts the number of
	\ttt{particle} in the subevent that pass the test. If there are two
	arguments, it counts the number of non-overlapping particle pairs (that pass
	the test, if any).


	\subsubsection{Predefined observables}

	The following real-valued observables are available in \sindarin\ for use in
	\ttt{eval}, \ttt{all}, \ttt{any}, \ttt{no}, and \ttt{count} constructs. The
	argument is always the subevent or alias enclosed in square brackets.
	\begin{itemize}
	\item \ttt{M2}
	\begin{itemize}
	\item One argument: Invariant mass squared of the (composite) particle in the
	argument.
	\item Two arguments: Invariant mass squared of the sum of the two momenta.
	\end{itemize}
	\item \ttt{M}
	\begin{itemize}
	\item Signed square root of \ttt{M2}: positive if $\ttt{M2}>0$, negative if
	$\ttt{M2}<0$.
	\end{itemize}
	\item \ttt{E}
	\begin{itemize}
	\item One argument: Energy of the (composite) particle in the argument.
	\item Two arguments: Sum of the energies of the two momenta.
	\end{itemize}
	\item \ttt{Px}, \ttt{Py}, \ttt{Pz}
	\begin{itemize}
	\item Like \ttt{E}, but returning the spatial momentum components.
	\end{itemize}
	\item \ttt{P}
	\begin{itemize}
	\item Like \ttt{E}, returning the absolute value of the spatial momentum.
	\end{itemize}
	\item \ttt{Pt}, \ttt{Pl}
	\begin{itemize}
	\item Like \ttt{E}, returning the transversal and longitudinal momentum,
	respectively.
	\end{itemize}
	\item \ttt{Theta}
	\begin{itemize}
	\item One argument: Absolute polar angle in the lab frame
	\item Two arguments: Angular distance of two particles in the lab frame.
	\end{itemize}
	\item \ttt{Theta\_star}
	Only with two arguments, gives the relative polar angle of the two momenta
	in the rest system of the momentum sum (i.e. mother particle).
	\item \ttt{Phi}
	\begin{itemize}
	\item One argument: Absolute azimuthal angle in the lab frame
	\item Two arguments: Azimuthal distance of two particles in the lab frame
	\end{itemize}
	\item \ttt{Rap}, \ttt{Eta}
	\begin{itemize}
	\item One argument: rapidity / pseudorapidity
	\item Two arguments: rapidity / pseudorapidity difference
	\end{itemize}
	\item \ttt{Dist}
	\begin{itemize}
	\item Two arguments: Distance on the $\eta$-$\phi$ cylinder, i.e.,
	$\sqrt{\Delta\eta^2 + \Delta\phi^2}$
	\end{itemize}
	\item \ttt{kT}
	\begin{itemize}
	\item Two arguments: $k_T$ jet clustering variable:
	$2 \min (E_{j1}^2, E_{j2}^2) / Q^2 \times (1 -
	\cos\theta_{j1,j2})$. At the moment, $Q^2 = 1$ GeV$^2$.
	\end{itemize}
	\end{itemize}
	There are also integer-valued observables:
	\begin{itemize}
	\item \ttt{PDG}
	\begin{itemize}
	\item One argument: PDG code of the particle. For a composite particle, the
	code is undefined (value 0). For flavor sums in the \ttt{cuts} statement,
	this observable always returns the same flavor, i.e. the first one from the
	flavor list. It is thus only sensible to use it in an \ttt{analysis} or
	\ttt{selection} statement when simulating events.
	\end{itemize}
	\item \ttt{Ncol}
	\begin{itemize}
	\item One argument: Number of open color lines. Only count color
	lines, not anticolor lines. This is defined only if the global flag
	\ttt{?colorize\_subevt} is true.
	\end{itemize}
	\item \ttt{Nacl}
	\begin{itemize}
	\item One argument: Number of open anticolor lines. Only count anticolor
	lines, not color lines. This is defined only if the global flag
	\ttt{?colorize\_subevt} is true.
	\end{itemize}
	\end{itemize}


	%%%%%%%%%%%%%%%

	\section{Physics Models}
	\label{sec:models}

	A physics model is a combination of particles, numerical parameters (masses,
	couplings, widths), and Feynman rules. Many physics analyses are done in the
	context of the Standard Model (SM). The SM is also the default model for
	\whizard. Alternatively, you can choose a subset of the SM (QED or QCD),
	variants of the SM (e.g., with or without nontrivial CKM matrix), or various
	extensions of the SM. The complete list is displayed in
	Table~\ref{tab:models}.

	The model definitions are contained in text files with filename extension
	\ttt{.mdl}, e.g., \ttt{SM.mdl}, which are located in the \ttt{share/models}
	subdirectory of the \whizard\ installation. These files are easily readable,
	so if you need details of a model implementation, inspect their contents. The
	model file contains the complete particle and parameter definitions as well as
	their default values. It also contains a list of vertices. This is used only
	for phase-space setup; the vertices used for generating amplitudes and the
	corresponding Feynman rules are stored in different files within the
	\oMega\ source tree.

	In a \sindarin\ script, a model is a special object of type \ttt{model}. There
	is always a \emph{current} model. Initially, this is the SM, so on startup
	\whizard\ reads the \ttt{SM.mdl} model file and assigns its content to the
	current model object. (You can change the default model by the \ttt{--model}
	option on the command line. Also the preloading of a model can be
	switched off with the \ttt{--no-model} option) Once the model has
	been loaded, you can define processes for the model, and you have all
	independent model parameters at your disposal. As noted before, these
	are intrinsic parameters which need not be declared when you assign
	them a value, for instance:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	mW = 80.33 GeV
	wH = 243.1 MeV
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Other parameters are \emph{derived}. They can be used in expressions like any
	other parameter, they are also intrinsic, but they cannot be modified directly
	at all. For instance, the electromagnetic coupling \ttt{ee} is a derived
	parameter. If you change either \ttt{GF} (the Fermi constant), \ttt{mW} (the
	$W$ mass), or \ttt{mZ} (the $Z$ mass), this parameter will reflect the change,
	but setting it directly is an error. In other words, the SM is defined within
	\whizard\ in the $G_F$-$m_W$-$m_Z$ scheme. (While this scheme is unusual for
	loop calculations, it is natural for a tree-level event generator where the
	$Z$ and $W$ poles have to be at their experimentally determined
	location\footnote{In future versions of \whizard\ it is foreseen to
	implement other electroweak schemes.}.)

	The model also defines the particle names and aliases that you can use for
	defining processes, cuts, or analyses.

	If you would like to generate a SUSY process instead, for instance, you can
	assign a different model (cf.\ Table~\ref{tab:models}) to the current model
	object:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	model = MSSM
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This assignment has the consequence that the list of SM parameters and
	particles is replaced by the corresponding MSSM list (which is much longer).
	The MSSM contains essentially all SM parameters by the same name, but in fact
	they are different parameters. This is revealed when you say
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	model = SM
	mb = 5.0 GeV
	model = MSSM
	show (mb)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	After the model is reassigned, you will see the MSSM value of $m_b$ which
	still has its default value, not the one you have given. However, if you
	revert to the SM later,
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	model = SM
	show (mb)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	you will see that your modification of the SM's $m_b$ value has been
	remembered. If you want both mass values to agree, you have to set them
	separately in the context of their respective model. Although this might seem
	cumbersome at first, it is nevertheless a sensible procedure since the
	parameters defined by the user might anyhow not be defined or available for
	all chosen models.

	When using two different models which need an SLHA input file,
	these {\em have} to be provided for both models.

	Within a given scope, there is only one current model. The current model can
	be reset permanently as above. It can also be temporarily be reset in a local
	scope, i.e., the option body of a command or the body of a \ttt{scan} loop.
	It is thus possible to use several models within the same script. For
	instance, you may define a SUSY signal process and a pure-SM background
	process. Each process depends only on the respective model's parameter set,
	and a change to a parameter in one of the models affects only the
	corresponding process.


	\section{Processes}
	\label{sec:processes}

	The purpose of \whizard\ is the integration and simulation of high-energy
	physics processes: scatterings and decays. Hence, \ttt{process} objects play
	the central role in \sindarin\ scripts.

	A \sindarin\ script may contain an arbitrary number of process definitions. The
	initial states need not agree, and the processes may belong to different
	physics models.


	\subsection{Process definition}
	\label{sec:procdef}

	A process object is defined in a straightforward notation. The definition
	syntax is straightforward:
	\begin{quote}
	\begin{footnotesize}
	\ttt{process \textit{process-id} = \textit{incoming-particles}} \verb\|=>\|
	\ttt{\textit{outgoing-particles}}
	\end{footnotesize}
	\end{quote}
	Here are typical examples:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	process w_pair_production = e1, E1 => "W+", "W-"
	process zdecay = Z => u, ubar
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Throughout the program, the process will be identified by its
	\textit{process-id}, so this is the name of the process object. This
	identifier is arbitrary, chosen by the user. It follows the rules for
	variable names, so it consists of alphanumeric characters and underscores,
	where the first character is not numeric. As a special rule, it must not
	contain upper-case characters. The reason is that this name is used for
	identifying the process not just within the script, but also within the
	\fortran\ code that the matrix-element generator produces for this process.

	After the equals sign, there follow the lists of incoming and outgoing
	particles. The number of incoming particles is either one or two: scattering
	processes and decay processes. The number of outgoing particles should be two
	or larger (as $2\to 1$ processes are proportional to a $\delta$
	function they can only be sensibly integrated when using a structure
	function like a hadron collider PDF or a beamstrahlung spectrum.).
	There is no hard upper limit; the complexity of processes that
	\whizard\ can handle depends only on the practical computing
	limitations (CPU time and memory). Roughly speaking, one can assume
	that processes up to $2\to 6$ particles are safe, $2\to 8$ processes
	are feasible given sufficient time for reaching a stable integration,
	while more complicated processes are largely unexplored.

	We emphasize that in the default setup, the matrix element of a physics
	process is computed exactly in leading-order perturbation theory, i.e., at
	tree level. There is no restriction of intermediate states, the result always
	contains the complete set of Feynman graphs that connect the initial with the
	final state. If the result would actually be expanded in Feynman graphs
	(which is not done by the \oMega\ matrix element generator that
	\whizard\ uses), the number of graphs can easily reach several thousands,
	depending on the complexity of the process and on the physics model.

	More details about the different methods for quantum field-theoretical
	matrix elements can be found in Chap.~\ref{chap:hardint}. In the
	following, we will discuss particle names, options for processes like
	restrictions on intermediate states, parallelization, flavor sums and
	process components for inclusive event samples (process containers).


	\subsection{Particle names}

	The particle names are taken from the particle definition in the current model
	file. Looking at the SM, for instance, the electron entry in
	\ttt{share/models/SM.mdl} reads
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	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
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This tells that you can identify an electron either as \verb\|"e-"\|, \verb\|e1\|,
	\verb\|electron\|, or simply \verb\|e\|. The first version is used for output,
	but needs to be quoted, because otherwise \sindarin\ would interpret the minus
	sign as an operator. (Technically, unquoted particle identifiers are aliases,
	while the quoted versions -- you can say either \verb\|e1\| or \verb\|"e1"\| --
	are names. On input, this makes no difference.) The alternative version
	\verb\|e1\| follows a convention, inherited from
	\comphep~\cite{Boos:2004kh}, that particles are indicated by lower
	case, antiparticles by upper case, and for leptons, the generation
	index is appended: \verb\|e2\| is the muon, \verb\|e3\| the tau. These
	alternative names need not be quoted because they contain no special
	characters.

	In Table~\ref{tab:SM-particles}, we list the recommended names as well as
	mass and width parameters for all SM particles. For other models, you may
	look up the names in the corresponding model file.

	\begin{table}[p]
	\begin{center}
	\begin{tabular}{\|l\|l\|l\|l\|cc\|}
	\hline
	& Particle & Output name & Alternative names & Mass & Width\\
	\hline\hline
	Leptons
	&$e^-$ & \verb\|e-\| & \ttt{e1}\quad\ttt{electron} & \ttt{me} & \\
	&$e^+$ & \verb\|e+\| & \ttt{E1}\quad\ttt{positron} & \ttt{me} & \\
	\hline
	&$\mu^-$ & \verb\|mu-\| & \ttt{e2}\quad\ttt{muon} & \ttt{mmu} & \\
	&$\mu^+$ & \verb\|mu+\| & \ttt{E2} & \ttt{mmu} & \\
	\hline
	&$\tau^-$ & \verb\|tau-\| & \ttt{e3}\quad\ttt{tauon} & \ttt{mtau} & \\
	&$\tau^+$ & \verb\|tau+\| & \ttt{E3} & \ttt{mtau} & \\
	\hline\hline
	Neutrinos
	&$\nu_e$ & \verb\|nue\| & \ttt{n1} & & \\
	&$\bar\nu_e$ & \verb\|nuebar\| & \ttt{N1} & & \\
	\hline
	&$\nu_\mu$ & \verb\|numu\| & \ttt{n2} & & \\
	&$\bar\nu_\mu$ & \verb\|numubar\| & \ttt{N2} & & \\
	\hline
	&$\nu_\tau$ & \verb\|nutau\| & \ttt{n3} & & \\
	&$\bar\nu_\tau$ & \verb\|nutaubar\| & \ttt{N3} & & \\
	\hline\hline
	Quarks
	&$d$ & \verb\|d\| & \ttt{down} & & \\
	&$\bar d$ & \verb\|dbar\| & \ttt{D} & & \\
	\hline
	&$u$ & \verb\|u\| & \ttt{up} & & \\
	&$\bar u$ & \verb\|ubar\| & \ttt{U} & & \\
	\hline
	&$s$ & \verb\|s\| & \ttt{strange} & \ttt{ms} & \\
	&$\bar s$ & \verb\|sbar\| & \ttt{S} & \ttt{ms} & \\
	\hline
	&$c$ & \verb\|c\| & \ttt{charm} & \ttt{mc} & \\
	&$\bar c$ & \verb\|cbar\| & \ttt{C} & \ttt{mc} & \\
	\hline
	&$b$ & \verb\|b\| & \ttt{bottom} & \ttt{mb} & \\
	&$\bar b$ & \verb\|bbar\| & \ttt{B} & \ttt{mb} & \\
	\hline
	&$t$ & \verb\|t\| & \ttt{top} & \ttt{mtop} & \ttt{wtop} \\
	&$\bar t$ & \verb\|tbar\| & \ttt{T} & \ttt{mtop} & \ttt{wtop} \\
	\hline\hline
	Vector bosons
	&$g$ & \verb\|gl\| & \ttt{g}\quad\ttt{G}\quad\ttt{gluon} & & \\
	\hline
	&$\gamma$ & \verb\|A\| & \ttt{gamma}\quad\ttt{photon} & & \\
	\hline
	&$Z$ & \verb\|Z\| & & \ttt{mZ} & \ttt{wZ} \\
	\hline
	&$W^+$ & \verb\|W+\| & \ttt{Wp} & \ttt{mW} & \ttt{wW} \\
	&$W^-$ & \verb\|W-\| & \ttt{Wm} & \ttt{mW} & \ttt{wW} \\
	\hline\hline
	Scalar bosons
	&$H$ & \verb\|H\| & \ttt{h}\quad \ttt{Higgs} & \ttt{mH} & \ttt{wH} \\
	\hline
	\end{tabular}
	\end{center}
	\caption{\label{tab:SM-particles} Names that can be used for SM particles.
	Also shown are the intrinsic variables that can be used to set mass and
	width, if applicable.}
	\end{table}

	Where no mass or width parameters are listed in the table, the particle is
	assumed to be massless or stable, respectively. This is obvious for particles
	such as the photon. For neutrinos, the mass is meaningless to particle
	physics collider experiments, so it is zero. For quarks, the $u$ or
	$d$ quark mass is unobservable directly, so we also set it zero. For
	the heavier quarks, the mass may play a role, so it is kept. (The $s$
	quark is borderline; one may argue that its mass is also unobservable
	directly.) On the other hand, the electron mass is relevant, e.g., in
	photon radiation without cuts, so it is not zero by default.

	It pays off to set particle masses to zero, if the approximation is justified,
	since fewer helicity states will contribute to the matrix element. Switching
	off one of the helicity states of an external fermion speeds up the
	calculation by a factor of two. Therefore, script files will usually contain
	the assignments
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	me = 0 mmu = 0 ms = 0 mc = 0
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	unless they deal with processes where this simplification is
	phenomenologically unacceptable. Often $m_\tau$ and $m_b$ can also be
	neglected, but this excludes processes where the Higgs couplings of $\tau$ or
	$b$ are relevant.

	Setting fermion masses to zero enables, furthermore, the possibility to define
	multi-flavor aliases
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	alias q = d:u:s:c
	alias Q = D:U:S:C
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	and handle processes such as
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	process two_jets_at_ilc = e1, E1 => q, Q
	process w_pairs_at_lhc = q, Q => Wp, Wm
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	where a sum over all allowed flavor combination is automatically included.
	For technical reasons, such flavor sums are possible only for massless
	particles (or more general for mass-degenerate particles). If you want
	to generate inclusive processes with sums over particles of different
	masses (e.g. summing over $W/Z$ in the final state etc.), confer below
	the section about process components, Sec.~\ref{sec:processcomp}.

	Assignments of masses, widths and other parameters are actually in effect when
	a process is integrated, not when it is defined. So, these assignments may
	come before or after the process definition, with no significant difference.
	However, since flavor summation requires masses to be zero, the assignments
	may be put before the alias definition which is used in the process.

	The muon, tau, and the heavier quarks are actually unstable. However, the
	width is set to zero because their decay is a macroscopic effect and, except for
	the muon, affected by hadron physics, so it is not described by \whizard. (In
	the current \whizard\ setup, all decays occur at the production vertex. A
	future version may describe hadronic physics and/or macroscopic particle
	propagation, and this restriction may be eventually removed.)




	\subsection{Options for processes}
	\label{sec:process options}

	The \ttt{process} definition may contain an optional argument:
	\begin{quote}
	\begin{footnotesize}
	\ttt{process \textit{process-id} = \textit{incoming-particles}} \verb\|=>\|
	\ttt{\textit{outgoing-particles}} \ttt{\{\textit{options\ldots}\}}
	\end{footnotesize}
	\end{quote}
	The \textit{options} are a \sindarin\ script that is executed in a context local
	to the \ttt{process} command. The assignments it contains apply only to the
	process that is defined. In the following, we describe the set of potentially
	useful options (which all can be also set globally):

	\subsubsection{Model reassignment}

	It is possible to locally reassign the model via a \ttt{model =} statment,
	permitting the definition of process using a model other than the globally
	selected model. The process will retain this association during
	integration and event generation.

	\subsubsection{Restrictions on matrix elements}
	\label{subsec:restrictions}

	Another useful option is the setting
	\begin{quote}
	\begin{footnotesize}
	\verb\|$restrictions =\| \ttt{\textit{string}}
	\end{footnotesize}
	\end{quote}
	This option allows to select particular classes of Feynman graphs for the
	process when using the \oMega\ matrix element generator. The
	\verb\|$restrictions\| string specifies e.g. propagators that the graph
	must contain. Here is an example:
	\begin{code}
	process zh_invis = e1, E1 => n1:n2:n3, N1:N2:N3, H { $restrictions = "1+2 ~ Z" }
	\end{code}
	The complete process $e^-e^+ \to \nu\bar\nu H$, summed over all neutrino
	generations, contains both $ZH$ pair production (Higgs-strahlung) and
	$W^+W^-\to H$ fusion. The restrictions string selects the Higgs-strahlung
	graph where the initial electrons combine to a $Z$ boson. Here, the particles
	in the process are consecutively numbered, starting with the initial
	particles. An alternative for the same selection would be
	\verb\|$restrictions = "3+4 ~ Z"\|. Restrictions can be combined using
	\verb\|&&\|, for instance
	\begin{code}
	$restrictions = "1+2 ~ Z && 3 + 4 ~ Z"
	\end{code}
	which is redundant here, however.

	The restriction keeps the full energy dependence in the intermediate
	propagator, so the Breit-Wigner shape can be observed in distributions. This
	breaks gauge invariance, in particular if the intermediate state is off shell,
	so you should use the feature only if you know the implications. For
	more details, cf. the Chap.~\ref{chap:hardint} and the \oMega\ manual.

	Other restrictions that can be combined with the restrictions above on
	intermediate propagators allow to exclude certain particles from
	intermediate propagators, or to exclude certain vertices from the
	matrix elements. For example,
	\begin{code}
	process eemm = e1, E1 => e2, E2 { $restrictions = "!A" }
	\end{code}
	would exclude all photon propagators from the matrix element and
	leaves only the $Z$ exchange here. In the same way,
	\verb\|$restrictions = "!gl"\| would exclude all gluon exchange. This
	exclusion of internal propagators works also for lists of particles,
	like
	\begin{code}
	$restrictions = "!Z:H"
	\end{code}
	excludes all $Z$ and $H$ propagators from the matrix elements.

	Besides excluding certain particles as internal lines, it is also
	possible to exclude certain vertices using the restriction command
	\begin{code}
	process eeww = e1, E1 => Wp, Wm { $restrictions = "^[W+,W-,Z]" }
	\end{code}
	This would generate the matrix element for the production of two $W$
	bosons at LEP without the non-Abelian vertex $W^+W^-Z$. Again, these
	restrictions are able to work on lists, so
	\begin{code}
	$restrictions = "^[W+,W-,A:Z]"
	\end{code}
	would exclude all triple gauge boson vertices from the above process
	and leave only the $t$-channel neutrino exchange.

	It is also possible to exlude vertices by their coupling constants,
	e.g. the photon exchange in the process $e^+ e^- \to \mu^+ \mu^-$ can
	also be removed by the following restriction:
	\begin{code}
	$restrictions = "^qlep"
	\end{code}
	Here, \ttt{qlep} is the \fortran\ variable for the coupling constant
	of the electron-positron-photon vertex.

	\begin{table}
	\begin{center}
	\begin{tabular}{\|l\|l\|}
	\hline
	\verb\|3+4~Z\| & external particles 3 and 4 must come from
	intermediate $Z$ \\\hline
	\verb\| && \| & logical ``and'', e.g. in
	\verb\| 3+5~t && 4+6~tbar\| \\\hline
	\verb\| !A \| & exclude all $\gamma$ propagators \\\hline
	\verb\| !e+:nue \| & exclude a list of propagators, here $\gamma$,
	$\nu_e$ \\\hline
	\verb\|^qlep:gnclep\| & exclude all vertices with
	\ttt{qlep},\ttt{gnclep} coupling constants \\\hline
	\verb\|^[A:Z,W+,W-]\| & exclude all vertices $W^+W^-Z$,
	$W^+W^-\gamma$ \\\hline
	\verb\|^c1:c2:c3[H,H,H]\| & exclude all triple Higgs couplings
	with $c_i$ constants
	\\\hline
	\end{tabular}
	\end{center}
	\caption{List of possible restrictions that can be applied to
	\oMega\ matrix elements.}
	\label{tab:restrictions}
	\end{table}
	The Tab.~\ref{tab:restrictions} gives a list of options that can be
	applied to the \oMega\ matrix elements.


	\subsubsection{Other options}

	There are some further options that the \oMega\ matrix-element generator can
	take. If desired, any string of options that is contained in this variable
	\begin{quote}
	\begin{footnotesize}
	\verb\|$omega_flags =\| \ttt{\textit{string}}
	\end{footnotesize}
	\end{quote}
	will be copied verbatim to the \oMega\ call, after all other options.

	One important application is the scheme of treating the width of unstable
	particles in the $t$-channel. This is modified by the \verb\|model:\| class of
	\oMega\ options.

	It is well known that for some processes, e.g., single $W$ production from
	photon-$W$ fusion, gauge invariance puts constraints on the treatment of the
	unstable-particle width. By default, \oMega\ puts a nonzero width in the $s$
	channel only. This correctly represents the resummed Dyson series for the
	propagator, but it violates QED gauge invariance, although the effect is only
	visible if the cuts permit the photon to be almost on-shell.

	An alternative is
	\begin{quote}
	\begin{footnotesize}
	\verb\|$omega_flags = "-model:fudged_width"\|
	\end{footnotesize},
	\end{quote}
	which puts zero width in the matrix element, so that gauge cancellations
	hold, and reinstates the $s$-channel width in the appropriate places by an
	overall factor that multiplies the whole matrix element.
	Note that the fudged width option only applies to charged unstable particles, such as the $W$ boson or top quark.
	Another possibility is
	\begin{quote}
	\begin{footnotesize}
	\verb\|$omega_flags = "-model:constant_width"\|
	\end{footnotesize},
	\end{quote}
	which puts the width both in the $s$- and in the $t$-channel like diagrams.
	A third option is provided by the running width scheme
	\begin{quote}
	\begin{footnotesize}
	\verb\|$omega_flags = "-model:running_width"\|
	\end{footnotesize},
	\end{quote}
	which applies the width only for $s$-channel like diagrams and multiplies it by a factor of $p^2 / M^2$.
	The additional $p^2$-dependent factor mimicks the momentum dependence of the imaginary part of a vacuum polarization for a particle decaying into massles decay products.
	It is noted that none of the above options preserves gauge invariance.

	For a gauge preserving approach (at least at tree level), \oMega\ provides the complex-mass scheme
	\begin{quote}
	\begin{footnotesize}
	\verb\|$omega_flags = "-model:cms_width\|
	\end{footnotesize}.
	\end{quote}
	However, in this case, one also has to modify the model in usage.
	For example, the parameter setting for the Standard Model can be changed by,
	\begin{quote}
	\begin{footnotesize}
	\verb\|model = SM (Complex_Mass_Scheme)\|
	\end{footnotesize}.
	\end{quote}

	\subsubsection{Multithreaded calculation of helicity sums via OpenMP}
	\label{sec:openmp}

	On multicore and / or multiprocessor systems, it is possible to speed
	up the calculation by using multiple threads to perform the helicity
	sum in the matrix element calculation. As the processing time used by
	\whizard\ is not used up solely in the matrix element, the speedup thus
	achieved varies greatly depending on the process under consideration;
	while simple processes without flavor sums do not profit significantly
	from this parallelization, the computation time for processes
	involving flavor sums with four or more particles in the final state
	is typically reduced by a factor between two and three when utilizing
	four parallel threads.

	The parallization is implemented using \ttt{OpenMP} and requires
	\whizard\ to be compiled with an \ttt{OpenMP} aware compiler and the
	appropiate compiler flags This is done in the configuration step, cf.\
	Sec.~\ref{sec:installation}.

	As with all \ttt{OpenMP} programs, the default number of threads used at
	runtime is up to the compiler runtime support and typically set to the
	number of independent hardware threads (cores / processors /
	hyperthreads) available in the system. This default can be adjusted
	by setting the \ttt{OMP\_NUM\_THREADS} environment variable prior to
	calling WHIZARD. Alternatively, the available number of threads can
	be reset anytime by the \sindarin\ parameter
	\ttt{openmp\_num\_threads}. Note however that the total number of
	threads that can be sensibly used is limited by the number of
	nonvanishing helicity combinations.

	%%%%%%%%%%%%%%%

	\subsection{Process components}
	\label{sec:processcomp}

	It was mentioned above that processes with flavor sums (in the initial
	or final state or both) have to be mass-degenerate (in most cases
	massless) in all particles that are summed over at a certain
	position. This condition is necessary in order to use the same
	phase-space parameterization and integration for the flavor-summed
	process. However, in many applications the user wants to handle
	inclusive process definitions, e.g. by defining inclusive decays,
	inclusive SUSY samples at hadron colliders (gluino pairs, squark
	pairs, gluino-squark associated production), or maybe lepton-inclusive
	samples where the tau and muon mass should be kept at different
	values. In \whizard\, from version v2.2.0 on, there is the possibility
	to define such inclusive process containers. The infrastructure for
	this feature is realized via so-called process components: processes
	are allowed to contain several process components. Those components
	need not be provided by the same matrix element generator,
	e.g. internal matrix elements, \oMega\ matrix elements, external
	matrix element (e.g. from a one-loop program, OLP) can be mixed. The
	very same infrastructure can also be used for next-to-leading order
	(NLO) calculations, containing the born with real emission, possible
	subtraction terms to make the several components infrared- and
	collinear finite, as well as the virtual corrections.

	Here, we want to discuss the use for inclusive particle samples. There
	are several options, the simplest of which to add up different final
	states by just using the \ttt{+} operator in \sindarin, e.g.:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	process multi_comp = e1, E1 => (e2, E2) + (e3, E3) + (A, A)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	The brackets are not only used for a better grouping of the expressions,
	they are not mandatory for \whizard\ to interpret the sum
	correctly. When integrating, \whizard\ tells you that this a process
	with three different components:
	\begin{footnotesize}
	\begin{Verbatim}
	\| Initializing integration for process multi_comp_1_p1:
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'multi_comp'
	\| Library name = 'default_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'multi_comp_i1': e-, e+ => m-, m+ [omega]
	\| 2: 'multi_comp_i2': e-, e+ => t-, t+ [omega]
	\| 3: 'multi_comp_i3': e-, e+ => A, A [omega]
	\| ------------------------------------------------------------------------
	\end{Verbatim}
	\end{footnotesize}
	A different phase-space setup is used for each different
	component. The integration for each different component is performed
	separately, and displayed on screen. At the end, a sum of all
	components is shown. All files that depend on the components are being
	attached an \ttt{\_i{\em <n>}} where \ttt{{\em <n>}} is the number of
	the process component that appears in the list above: the \fortran\
	code for the matrix element, the \ttt{.phs} file for the phase space
	parameterization, and the grid files for the \vamp\ Monte-Carlo
	integration (or any other integration method). However, there will be
	only one event file for the inclusive process, into which a mixture of
	events according to the size of the individual process component cross
	section enter.

	More options are to specify additive lists of particles. \whizard\
	then expands the final states according to tensor product algebra:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	process multi_tensor = e1, E1 => e2 + e3 + A, E2 + E3 + A
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This gives the same three process components as above, but \whizard\
	recognized that e.g. $e^- e^+ \to \mu^- \gamma$ is a vanishing
	process, hence the numbering is different:
	\begin{footnotesize}
	\begin{Verbatim}
	\| Process component 'multi_tensor_i2': matrix element vanishes
	\| Process component 'multi_tensor_i3': matrix element vanishes
	\| Process component 'multi_tensor_i4': matrix element vanishes
	\| Process component 'multi_tensor_i6': matrix element vanishes
	\| Process component 'multi_tensor_i7': matrix element vanishes
	\| Process component 'multi_tensor_i8': matrix element vanishes
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'multi_tensor'
	\| Library name = 'default_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'multi_tensor_i1': e-, e+ => m-, m+ [omega]
	\| 5: 'multi_tensor_i5': e-, e+ => t-, t+ [omega]
	\| 9: 'multi_tensor_i9': e-, e+ => A, A [omega]
	\| ------------------------------------------------------------------------
	\end{Verbatim}
	\end{footnotesize}
	Identical copies of the same process that would be created by
	expanding the tensor product of final states are eliminated and appear
	only once in the final sum of process components.

	Naturally, inclusive process definitions are also available for
	decays:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	process multi_dec = Wp => E2 + E3, n2 + n3
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	This yields:
	\begin{footnotesize}
	\begin{Verbatim}
	\| Process component 'multi_dec_i2': matrix element vanishes
	\| Process component 'multi_dec_i3': matrix element vanishes
	\| ------------------------------------------------------------------------
	\| Process [decay]: 'multi_dec'
	\| Library name = 'default_lib'
	\| Process index = 2
	\| Process components:
	\| 1: 'multi_dec_i1': W+ => mu+, numu [omega]
	\| 4: 'multi_dec_i4': W+ => tau+, nutau [omega]
	\| ------------------------------------------------------------------------
	\end{Verbatim}
	\end{footnotesize}


	%%%%%%%%%%%%%%%

	\subsection{Compilation}
	\label{sec:compilation}

	Once processes have been set up, to make them available for integration they
	have to be compiled. More precisely, the matrix-element generator
	\oMega\ (and it works similarly if a different matrix element method
	is chosen) is called to generate matrix element code, the compiler is
	called to transform this \fortran\ code into object files, and the
	linker is called to collect this in a dynamically loadable library.
	Finally, this library is linked to the program. From version v2.2.0 of
	\whizard\ this is no longer done by system calls of the OS but steered
	via process library Makefiles. Hence, the user can execute and
	manipulate those Makefiles in order to manually intervene in the
	particular steps, if he/she wants to do so.

	All this is done automatically when an \ttt{integrate}, \ttt{unstable}, or
	\ttt{simulate} command is encountered for the first time. You may also force
	compilation explicitly by the command
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	compile
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	which performs all steps as listed above, including loading the generated
	library.

	The \fortran\ part of the compilation will be done using the \fortran\ compiler
	specified by the string variable
	\verb\|$fc\| and the compiler flags specified as \verb\|$fcflags\|. The default
	settings are those that have been used for compiling \whizard\ itself during
	installation. For library compatibility, you should stick to the compiler.
	The flags may be set differently. They are applied in the compilation and
	loading steps, and they are processed by \ttt{libtool}, so
	\ttt{libtool}-specific flags can also be given.

	\whizard\ has some precautions against unnecessary repetitions. Hence, when a
	\ttt{compile} command is executed (explicitly, or implicitly by the first
	integration), the program checks first whether the library is already loaded,
	and whether source code already exists for the requested processes. If yes,
	this code is used and no calls to \oMega\ (or another matrix element
	method) or to the compiler are issued.
	Otherwise, it will detect any modification to the process configuration and
	regenerate the matrix element or recompile accordingly. Thus, a \sindarin\
	script can be executed repeatedly without rebuilding everything from scratch,
	and you can safely add more processes to a script in a subsequent run without
	having to worry about the processes that have already been treated.

	This default behavior can be changed. By setting
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	?rebuild_library = true
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	code will be re-generated and re-compiled even if \whizard\ would think that
	this is unncessary. The same effect is achieved by calling \whizard\ with a
	command-line switch,
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	/home/user$ whizard --rebuild_library
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	There are further \ttt{rebuild} switches which are described below. If
	everything is to be rebuilt, you can set a master switch \ttt{?rebuild} or the
	command line option \verb\|--rebuild\|. The latter can be abbreviated as a short
	command-line option:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	/home/user$ whizard -r
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Setting this switch is always a good idea when starting a new project, just in
	case some old files clutter the working directory. When re-running the same
	script, possibly modified, the \verb\|-r\| switch should be omitted, so the
	existing files can be reused.



	\subsection{Process libraries}

	Processes are collected in \emph{libraries}. A script may use more than one
	library, although for most applications a single library will probably be
	sufficient.

	The default library is \ttt{default\_lib}. If you do not specify anything else,
	the processes you compile will be collected by a driver file
	\ttt{default\_lib.f90} which is compiled together with the process code and
	combined as a libtool archive \ttt{default\_lib.la}, which is dynamically linked
	to the running \whizard\ process.

	Once in a while, you work on several projects at once, and you didn't care
	about opening a new working directory for each. If the \verb\|-r\| option is
	given, a new run will erase the existing library, which may contain processes
	needed for the other project. You could omit \verb\|-r\|, so all processes will
	be collected in the same library (this does not hurt), but you may wish to
	cleanly separate the projects. In that case, you should open a separate
	library for each project.

	Again, there are two possibilities. You may start the script with the
	specification
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	library = "my_lhc_proc"
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	to open a library \verb\|my_lhc_proc\| in place of the default library.
	Repeating the command with different arguments, you may introduce several
	libraries in the script. The active library is always the one specified
	last. It is possible to issue this command locally, so a particular process
	goes into its own library.

	Alternatively, you may call \whizard\ with the option
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	/home/user$ whizard --library=my_lhc_proc
	\end{verbatim}
	\end{footnotesize}
	\end{quote}

	If several libraries are open simultaneously, the \ttt{compile} command will
	compile all libraries that the script has referenced so far. If this is not
	intended, you may give the command an argument,
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	compile ("my_lhc_proc", "my_other_proc")
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	to compile only a specific subset.

	The command
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	show (library)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	will display the contents of the actually loaded library together with
	a status code which indicates the status of the library and the processes within.

	%%%%%%%%%%%%%%%

	\subsection{Stand-alone \whizard\ with precompiled processes}
	\label{sec:static}

	Once you have set up a process library, it is straightforward to make a
	special stand-alone \whizard\ executable which will have this library
	preloaded on startup. This is a matter of convenience, and it is also useful
	if you need a statically linked executable for reasons of profiling,
	batch processing, etc.

	For this task, there is a variant of the \ttt{compile} command:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	compile as "my_whizard" ()
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	which produces an executable \verb\|my_whizard\|. You can omit the library
	argument if you simply want to include everything. (Note that this command
	will \emph{not} load a library into the current process, it is intended for
	creating a separate program that will be started independently.)

	As an example, the script
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	process proc1 = e1, E1 => e1, E1
	process proc2 = e1, E1 => e2, E2
	process proc3 = e1, E1 => e3, E3
	compile as "whizard-leptons" ()
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	will make a new executable program \verb\|whizard-leptons\|. This
	program behaves completely identical to vanilla \whizard, except for the fact
	that the processes \ttt{proc1}, \ttt{proc2}, and \ttt{proc3} are available
	without configuring them or loading any library.

	% This feature is particularly useful when compiling with the \ttt{-static}
	% flag. As long as the architecture is compatible, the resulting binary may be
	% run on a different computer where no \whizard\ libraries are present. (The
	% program will still need to find its model files, however.)



	\section{Beams}
	\label{sec:beams}

	Before processes can be integrated and simulated, the program has to know
	about the collider properties. They can be specified by the \ttt{beams}
	statement.

	In the command script, it is irrelevant whether a \ttt{beams} statement comes
	before or after process specification. The \ttt{integrate} or \ttt{simulate}
	commands will use the \ttt{beams} statement that was issued last.


	\subsection{Beam setup}
	\label{sec:beam-setup}

	If the beams have no special properties, and the colliding particles are the
	incoming particles in the process themselves, there is no need for a
	\ttt{beams} statement at all. You only \emph{must} specify the
	center-of-momentum energy of the collider by setting the value of $\sqrt{s}$,
	for instance
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	sqrts = 14 TeV
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	The \ttt{beams} statement comes into play if
	\begin{itemize}
	\item
	the beams have nontrivial structure, e.g., parton structure in hadron
	collision or photon radiation in lepton collision, or
	\item
	the beams have non-standard properties: polarization, asymmetry, crossing
	angle.
	\end{itemize}
	Note that some of the abovementioned beam properties had not yet been
	reimplemented in the \whizard\ttt{2} release series. From version
	v2.2.0 on all options of the legacy series \whizard\ttt{1} are
	available again. From version v2.1 to version v2.2 of \whizard\ there
	has also been a change in possible options to the \ttt{beams}
	statement: in the early versions of \whizard\ttt{2} (v2.0/v2.1), local
	options could be specified within the beam settings, e.g. \ttt{beams =
	p, p { sqrts = 14 TeV } => pdf\_builtin}. These possibility has been
	abandoned from version v2.2 on, and the \ttt{beams} command does not
	allow for {\em any} optional arguments any more.

	Hence, beam parameters can -- with the exception of the specification
	of structure functions -- be specified only globally:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	sqrts = 14 TeV
	beams = p, p => lhapdf
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	It does not make any difference whether the value of \ttt{sqrts} is
	set before or after the \ttt{beams} statement, the last value found
	before an \ttt{integrate} or \ttt{simulate} is the relevant one. This
	in particularly allows to specify the beam structure, and then after
	that perform a loop or scan over beam energies, beam parameters, or
	structure function settings.

	The \ttt{beams} statement also applies to particle decay processes, where there
	is only a single beam. Here, it is usually redundant because no structure
	functions are possible, and the energy is fixed to the decaying particle's
	mass. However, it is needed for computing polarized decay, e.g.
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = Z
	beams_pol_density = @(0)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	where for a boson at rest, the polarization axis is defined to be the $z$
	axis.

	Beam polarization is described in detail below in Sec.~\ref{sec:polarization}.

	Note also that future versions of \whizard\ might give support for
	single-beam events, where structure functions for single particles
	indeed do make sense.

	In the following sections we list the available options for structure
	functions or spectra inside \whizard\ and explain their usage. More
	about the physics of the implemented structure functions can be found
	in Chap.~\ref{chap:hardint}.

	%%%%%%%%%%%%%%%

	\subsection{Asymmetric beams and Crossing angles}
	\label{sec:asymmetricbeams}

	\whizard\ not only allows symmetric beam collisions, but basically
	arbitrary collider setups. In the case there are two different beam
	energies, the command
	\begin{quote}
	\begin{footnotesize}
	\ttt{beams\_momentum = {\em <beam\_mom1>}, {\em <beam\_mom2>}}
	\end{footnotesize}
	\end{quote}
	allows to specify the momentum (or as well energies for massless
	particles) for the beams. Note that for scattering processes both
	values for the beams must be present. So the following to setups for
	14 TeV LHC proton-proton collisions are equivalent:
	\begin{quote}
	\begin{footnotesize}
	\ttt{beams = p, p => pdf\_builtin} \newline
	\ttt{sqrts = 14 TeV}
	\end{footnotesize}
	\end{quote}
	and
	\begin{quote}
	\begin{footnotesize}
	\ttt{beams = p, p => pdf\_builtin} \newline
	\ttt{beams\_momentum = 7 TeV, 7 TeV}
	\end{footnotesize}
	\end{quote}
	Asymmetric setups can be set by using different values for the two
	beam momenta, e.g. in a HERA setup:
	\begin{quote}
	\begin{footnotesize}
	\ttt{beams = e, p => none, pdf\_builtin}
	\ttt{beams\_momentum = 27.5 GeV, 920 GeV}
	\end{footnotesize}
	\end{quote}
	or for the BELLE experiment at the KEKB accelerator:
	\begin{quote}
	\begin{footnotesize}
	\ttt{beams = e1, E1}
	\ttt{beams\_momentum = 8 GeV, 3.5 GeV}
	\end{footnotesize}
	\end{quote}
	\whizard\ lets you know about the beam structure and calculates for
	you that the center of mass energy corresponds to 10.58 GeV:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	\| Beam structure: e-, e+
	\| momentum = 8.000000000000E+00, 3.500000000000E+00
	\| Beam data (collision):
	\| e- (mass = 5.1099700E-04 GeV)
	\| e+ (mass = 5.1099700E-04 GeV)
	\| sqrts = 1.058300530253E+01 GeV
	\| Beam structure: lab and c.m. frame differ
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}

	It is also possible to specify beams for decaying particles, where
	\ttt{beams\_momentum} then only has a single argument, e.g.:
	\begin{quote}
	\begin{footnotesize}
	\ttt{process zee = Z => "e-", "e+"} \\
	\ttt{beams = Z} \\
	\ttt{beams\_momentum = 500 GeV} \\
	\ttt{simulate (zee) \{ n\_events = 100 \} }
	\end{footnotesize}
	\end{quote}
	This would correspond to a beam of $Z$ bosons with a momentum of 500
	GeV. Note, however, that \whizard\ will always do the integration of
	the particle width in the particle's rest frame, while the moving beam
	is then only taken into account for the frame of reference for the
	simulation.

	Further options then simply having different beam energies describe a
	non-vanishing between the two incoming beams. Such concepts are quite
	common e.g. for linear colliders to improve the beam properties in the
	collimation region at the beam interaction points. Such crossing
	angles can be specified in the beam setup, too, using the
	\ttt{beams\_theta} command:
	\begin{quote}
	\begin{footnotesize}
	\ttt{beams = e1, E1} \\
	\ttt{beams\_momentum = 500 GeV, 500 GeV} \\
	\ttt{beams\_theta = 0, 10 degree}
	\end{footnotesize}
	\end{quote}
	It is important that when a crossing angle is being specified, and the
	collision system consequently never is the center-of-momentum system,
	the beam momenta have to explicitly set. Besides a planar crossing
	angle, one is even able to rotate an azimuthal distance:
	\begin{quote}
	\begin{footnotesize}
	\ttt{beams = e1, E1} \\
	\ttt{beams\_momentum = 500 GeV, 500 GeV} \\
	\ttt{beams\_theta = 0, 10 degree} \\
	\ttt{beams\_phi = 0, 45 degree}
	\end{footnotesize}
	\end{quote}

	%%%%%%%%%%%%%%%

	\subsection{LHAPDF}
	\label{sec:lhapdf}

	For incoming hadron beams, the \ttt{beams} statement specifies which structure
	functions are used. The simplest example is the study of parton-parton
	scattering processes at a hadron-hadron collider such as LHC or Tevatron. The
	\lhapdf\ structure function set is selected by a syntax similar to the
	process setup, namely the example already shown above:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = p, p => lhapdf
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Note that there are slight differences in using the \lhapdf\ release
	series 6 and the older \fortran\ \lhapdf\ release series 5, at least
	concerning the naming conventions for the PDF sets~\footnote{Until
	\whizard\ version 2.2.1 including, only the \lhapdf\ series 5 was
	supported, while from version 2.2.2 on also the \lhapdf\ release
	series 6 has been supported.}. The above \ttt{beams}
	statement selects a default \lhapdf\ structure-function set for both
	proton beams (which is the \ttt{CT10} central set for \lhapdf\ 6, and
	\ttt{cteq6ll.LHpdf} central set for \lhapdf 5). The structure
	function will apply for all quarks, antiquarks, and the gluon as far
	as supported by the particular \lhapdf\ set. Choosing a different set
	is done by adding the filename as a local option to the \ttt{lhapdf}
	keyword:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = p, p => lhapdf
	$lhapdf_file = "MSTW2008lo68cl"
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	for the actual \lhapdf\ 6 series, and
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = p, p => lhapdf
	$lhapdf_file = "MSTW2008lo68cl.LHgrid"
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	for \lhapdf 5.Similarly, a member within the set is selected by the
	numeric variable \verb\|lhapdf_member\| (for both release series of \lhapdf).

	In some cases, different structure functions have to be chosen for the two
	beams. For instance, we may look at $ep$ collisions:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = "e-", p => none, lhapdf
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Here, there is a list of two independent structure functions (each with its
	own option set, if applicable) which applies to the two beams.

	Another mixed case is $p\gamma$ collisions, where the photon is to be
	resolved as a hadron. The simple assignment
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = p, gamma => lhapdf, lhapdf_photon
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	will be understood as follows: \whizard\ selects the appropriate default
	structure functions (here we are using \lhapdf\ 5 as an example as the
	support of photon and pion PDFs in \lhapdf\ 6 has been dropped),
	\ttt{cteq6ll.LHpdf} for the proton and
	\ttt{GSG960.LHgrid} for the photon. The photon case has an additional
	integer-valued parameter \verb\|lhapdf_photon_scheme\|. (There are also pion
	structure functions available.) For modifying the default, you have to
	specify separate structure functions
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = p, gamma => lhapdf, lhapdf_photon
	$lhapdf_file = ...
	$lhapdf_photon_file = ...
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Finally, the scattering of elementary photons on partons is described by
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = p, gamma => lhapdf, none
	\end{verbatim}
	\end{footnotesize}
	\end{quote}

	Note that for \lhapdf\ version 5.7.1 or higher and for PDF sets which
	support it, photons can be used as partons.

	There is one more option for the \lhapdf\ PDFs, namely to specify the
	path where the \lhapdf\ PDF sets reside: this is done with the string
	variable \ttt{\$lhapdf\_dir = "{\em <path-to-lhapdf>}"}. Usually, it
	is not necessary to set this because \whizard\ detects this path via
	the \ttt{lhapdf-config} script during configuration, but in the case
	paths have been moved, or special files/special locations are to be
	used, the user can specify this location explicitly.

	%%%%%%%%%%%%%%%

	\subsection{Built-in PDFs}
	\label{sec:built-in-pdf}

	In addition to the possibility of linking against \lhapdf, \whizard\
	comes with a couple of built-in PDFs which are selected via the
	\verb?pdf_builtin? keyword
	%
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = p, p => pdf_builtin
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	%

	The default PDF set is CTEQ6L, but other choices are also available by
	setting the string variable \verb?$pdf_builtin_set? to an
	appropiate value. E.g, modifying the above
	setup to
	%
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = p, p => pdf_builtin
	$pdf_builtin_set = "mrst2004qedp"
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	%
	would select the proton PDF from the MRST2004QED set. A list of all currently
	available PDFs can be found in Table~\ref{tab:pdfs}.
	%
	\begin{table}
	\centerline{\begin{tabular}{\|l\|\|l\|p{0.2\textwidth}\|l\|}
	\hline
	Tag & Name & Notes & References \\\hline\hline
	%
	\ttt{cteq6l} & CTEQ6L & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Pumplin:2002vw} \\\hline
	\ttt{cteq6l1} & CTEQ6L1 & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Pumplin:2002vw} \\\hline
	\ttt{cteq6d} & CTEQ6D & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Pumplin:2002vw} \\\hline
	\ttt{cteq6m} & CTEQ6M & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Pumplin:2002vw} \\\hline
	\hline
	\ttt{mrst2004qedp} & MRST2004QED (proton) & includes photon &
	\cite{Martin:2004dh} \\\hline
	\hline
	\ttt{mrst2004qedn} & MRST2004QED (neutron) & includes photon &
	\cite{Martin:2004dh} \\\hline
	\hline
	\ttt{mstw2008lo} & MSTW2008LO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Martin:2009iq} \\\hline
	\ttt{mstw2008nlo} & MSTW2008NLO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Martin:2009iq} \\\hline
	\ttt{mstw2008nnlo} & MSTW2008NNLO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Martin:2009iq} \\\hline
	\hline
	\ttt{ct10} & CT10 & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Lai:2010vv} \\\hline
	\hline
	\ttt{CJ12\_max} & CJ12\_max & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Owens:2012bv} \\\hline
	\ttt{CJ12\_mid} & CJ12\_mid & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Owens:2012bv} \\\hline
	\ttt{CJ12\_min} & CJ12\_min & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Owens:2012bv} \\\hline
	\hline
	\ttt{CJ15LO} & CJ15LO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Accardi:2016qay} \\\hline
	\ttt{CJ15NLO} & CJ15NLO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Accardi:2016qay} \\\hline
	\hline
	\ttt{mmht2014lo} & MMHT2014LO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Harland-Lang:2014zoa} \\\hline
	\ttt{mmht2014nlo} & MMHT2014NLO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Harland-Lang:2014zoa} \\\hline
	\ttt{mmht2014nnlo} & MMHT2014NNLO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Harland-Lang:2014zoa} \\\hline
	\hline
	\ttt{CT14LL} & CT14LLO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Dulat:2015mca} \\\hline
	\ttt{CT14L} & CT14LO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Dulat:2015mca} \\\hline
	\ttt{CT14N} & CT1414NLO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Dulat:2015mca} \\\hline
	\ttt{CT14NN} & CT14NNLO & \mbox{}\hfill---\hfill\mbox{} &
	\cite{Dulat:2015mca} \\\hline
	\hline
	%
	\end{tabular}}
	\caption{All PDF sets available as builtin sets. The two MRST2004QED
	sets also contain a photon.}
	\label{tab:pdfs}
	\end{table}

	The two MRST2004QED sets also contain the photon as a parton, which
	can be used in the same way as for \lhapdf\ from v5.7.1 on. Note,
	however, that there is no builtin PDF that contains a photon structure
	function. There is a \ttt{beams} structure function specifier
	\ttt{pdf\_builtin\_photon}, but at the moment this throws an error. It
	just has been implemented for the case that in future versions of
	\whizard\ a photon structure function might be included.

	Note that in general only the data sets for the central values of the
	different PDFs ship with \whizard. Using the error sets is possible,
	i.e. it is supported in the syntax of the code, but you have to
	download the corresponding data sets from the web pages of the PDF
	fitting collaborations.

	%%%%%%%%%%%%%%%

	\subsection{HOPPET $b$ parton matching}

	When the \hoppet\ tool~\cite{Salam:2008qg} for hadron-collider PDF
	structure functions and their manipulations are
	correctly linked to \whizard, it can be used for advanced
	calculations and simulations of hadron collider physics. Its main
	usage inside \whizard\ is for matching schemes between 4-flavor and
	5-flavor schemes in $b$-parton initiated processes at hadron
	colliders. Note that in versions 2.2.0 and 2.2.1 it only worked
	together with \lhapdf\ version 5, while with the \lhapdf\ version 6
	interface from version 2.2.2 on it can be used also with the modern
	version of PDFs from \lhapdf. Furthermore, from version 2.2.2, the
	\hoppet\ $b$ parton matching also works for the builtin PDFs.

	It depends on the corresponding process and the energy scales involved
	whether it is a better description to use the
	$g\to b\bar b$ splitting from the DGLAP evolution inside the PDF and
	just take the $b$ parton content of a PDF, e.g. in BSM Higgs
	production for large $\tan\beta$: $pp \to H$ with a partonic
	subprocess $b\bar b \to H$, or directly take the gluon PDFs and use
	$pp \to b\bar b H$ with a partonic subprocess $gg \to b \bar b
	H$. Elaborate schemes for a proper matching between the two
	prescriptions have been developed and have been incorporated into the
	\hoppet\ interface.

	Another prime example for using these matching schemes is single top
	production at hadron colliders. Let us consider the following setup:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	process proc1 = b, u => t, d
	process proc2 = u, b => t, d
	process proc3 = g, u => t, d, B { $restrictions = "2+4 ~ W+" }
	process proc4 = u, g => t, d, B { $restrictions = "1+4 ~ W+" }

	beams = p,p => pdf_builtin
	sqrts = 14 TeV
	?hoppet_b_matching = true

	$sample = "single_top_matched"
	luminosity = 1 / 1 fbarn
	simulate (proc1, proc2, proc3, proc4)
	\end{Verbatim}
	\end{footnotesize}%$
	\end{quote}
	The first two processes are single top production from $b$ PDFs, the
	last two processes contain an explicit $g\to b\bar b$ splitting (the
	restriction, cf. Sec.~\ref{sec:process options} has been placed in
	order to single out the single top production signal process). PDFs
	are then chosen from the default builtin PDF (which is \ttt{CTEQ6L}),
	and the \hoppet\ matching routines are switched on by the flag
	\ttt{?hoppet\_b\_matching}.

	%%%%%%%%%%%%%%%

	\subsection{Lepton Collider ISR structure functions}
	\label{sec:lepton_isr}

	Initial state QED radiation off leptons is an important feature at all
	kinds of lepton colliders: the radiative return to the $Z$ resonance
	by ISR radiation was in fact the largest higher-order effect for the
	SLC and LEP I colliders. The soft-collinear and soft photon radiation
	can indeed be resummed/exponentiated to all orders in perturbation
	theory~\cite{Gribov:1972rt}, while higher orders in hard-collinear
	photons have to be explicitly calculated order by
	order~\cite{Kuraev:1985hb,Skrzypek:1990qs}. \whizard\ has an intrinsic
	implementation of the lepton ISR structure function that includes all
	orders of soft and soft-collinear photons as well as up to the third
	order in hard-collinear photons. It can be switched on by the
	following statement:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	beams = e1, E1 => isr
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	As the ISR structure function is a single-beam structure function,
	this expression is synonymous for
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	beams = e1, E1 => isr, isr
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	The ISR structure function can again be applied to only one of the two
	beams, e.g. in a HERA-like setup:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	beams = e1, p => isr, pdf_builtin
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}

	Their are several options for the lepton-collider ISR structure
	function that are summarized in the following:

	\vspace{2mm}

	\centerline{\begin{tabular}{\|l\|l\|l\|}\hline
	Parameter & Default & Meaning \\\hline\hline
	\ttt{isr\_alpha} & \ttt{0}/intrinsic & value of $\alpha_{QED}$ for ISR
	\\\hline
	\ttt{isr\_order} & \ttt{3} & max. order of hard-collinear photon
	emission \\\hline
	\ttt{isr\_mass} & \ttt{0}/intrinsic & mass of the radiating lepton \\\hline
	\ttt{isr\_q\_max} & \ttt{0}/$\sqrt{s}$ & upper cutoff for ISR \\\hline
	\hline
	\ttt{?isr\_recoil} & \ttt{false} & flag to switch on recoil/$p_T$
	(\emph{deprecated})\\\hline
	\ttt{?isr\_keep\_energy} & \ttt{false} & recoil flag: conserve
	energy in splitting (\emph{deprecated})
	\\\hline
	\end{tabular}}\mbox{}

	The maximal order of the hard-collinear photon emission taken into
	account by \whizard\ is set by the integer variable \ttt{isr\_order};
	the default is the maximally available order of three. With the
	variable \ttt{isr\_alpha}, the value of the QED coupling constant
	$\alpha_{QED}$ used in the ISR structure function can be set. The
	default is taken from the active physics model. The mass of the
	radiating lepton (in most cases the electron) is set by
	\ttt{isr\_mass}; again the default is taken from the active physics
	model. Furthermore, the upper integration border for the ISR structure
	function which acts roughly as an upper hardness cutoff for the emitted
	photons, can be set through \ttt{isr\_q\_max}; if not set, the
	collider energy (possibly after beamstrahlung,
	cf. Sec.~\ref{sec:beamstrahlung}) $\sqrt{s}$ (or $\sqrt{\widehat{s}}$)
	is taken. Note that \whizard\ accounts for the
	exclusive effects of ISR radiation at the moment by a single (hard,
	resolved) photon in the event; a more realistic treatment of exclusive
	ISR photons in simulation is foreseen for a future version.

	While the ISR structure function is evaluated in the collinear limit,
	it is possible to generate transverse momentum for both the radiated
	photons and the recoiling partonic system. We recommend to stick to
	the collinear approximation for the integration step. Integration
	cuts should be set up such that they do not significantly depend on
	photon transverse momentum. In a subsequent simulation step, it is
	possible to transform the events with collinear ISR radiation into
	more realistic events with non-collinear radiation. To this end,
	\whizard\ provides a separate ISR photon handler which can be
	activated in the simulation step. The algorithm operates on the
	partonic event: it takes the radiated photons and the partons entering
	the hard process, and applies a $p_T$ distribution to those particles
	and their interaction products, i.e., all outgoing particles. Cuts
	that depend on photon $p_T$ may be applied to the modified events.
	For details on the ISR photon handler,
	cf.\ Sec.~\ref{sec:isr-photon-handler}.

	{\footnotesize The flag \ttt{?isr\_recoil} switches on $p_T$ recoil of
	the emitting lepton against photon radiation during integration; per
	default it is off. The flag \ttt{?isr\_keep\_energy} controls the
	mode of on-shell projection for the splitting process with $p_T$.
	Note that this feature is kept for backwards compatibility, but
	should not be used for new simulations. The reason is as follows:
	For a fraction of events, $p_T$ will become significant, and (i)
	energy/momentum non-conservation, applied to both beams separately,
	can lead to unexpected and unphysical effects, and (ii) the modified
	momenta enter the hard process, so the collinear approximation used
	in the ISR structure function computation does not hold. }

	%%%%%%%%%%%%%%%

	\subsection{Lepton Collider Beamstrahlung}
	\label{sec:beamstrahlung}

	At linear lepton colliders, the macroscopic electromagnetic
	interaction of the bunches leads to a distortion of the spectrum of
	the bunches that is important for an exact simulation of the beam
	spectrum. There are several methods to account for these effects. The
	most important tool to simulate classical beam-beam interactions in
	lepton-collider physics is
	\ttt{GuineaPig++}~\cite{Schulte:1998au,Schulte:1999tx,Schulte:2007zz}. A
	direct interface between this tool \ttt{GuineaPig++} and \whizard\ had
	existed as an inofficial add-on to the legacy branch \whizard\ttt{1},
	but is no longer applicable in \whizard\ttt{2}. A \whizard-internal
	interface is foreseen for the very near future, most probably within
	this v2.2 release. Other options are to use parameterizations of the
	beam spectrum that have been included in the package \circeone~\cite{CIRCE}
	which has been interfaced to \whizard\ since version v1.20 and been
	included in the \whizard\ttt{2} release series. Another option is to
	generate a beam spectrum externally and then read it in as an ASCII
	data file, cf. Sec.~\ref{sec:beamevents}. More about this can be found
	in a dedicated section on lepton collider spectra,
	Sec.~\ref{sec:beamspectra}.

	In this section, we discuss the usage of beamstrahlung spectra by
	means of the \circeone\ package. The beamstrahlung spectra are
	true spectra, so they have to be applied to pairs of beams, and an
	application to only one beam is meaningless. They are switched on by
	this \ttt{beams} statement including structure functions:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	beams = e1, E1 => circe1
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	It is important to note that the parameterization of the beamstrahlung
	spectra within \circeone\ contain also processes where $e\to\gamma$
	conversions have been taking place, i.e. also hard processes with one
	(or two) initial photons can be simulated with beamstrahlung switched
	on. In that case, the explicit photon flags, \ttt{?circe1\_photon1}
	and \ttt{?circe1\_photon2}, for the two beams have to be properly set,
	e.g. (ordering in the final state does not play a role):
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	process proc1 = A, e1 => A, e1
	sqrts = 500 GeV
	beams = e1, E1 => circe1
	?circe1_photon1 = true
	integrate (proc1)

	process proc2 = e1, A => A, e1
	sqrts = 1000 GeV
	beams = e1, A => circe1
	?circe1_photon2 = true
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	or
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	process proc1 = A, A => Wp, Wm
	sqrts = 200 GeV
	beams = e1, E1 => circe1
	?circe1_photon1 = true
	?circe1_photon2 = true
	?circe1_generate = false
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	In all cases (one or both beams with photon conversion) the beam
	spectrum applies to both beams simultaneously.

	In the last example ($\gamma\gamma\to W^+W^-$) the default
	\circeone\ generator mode was turned off by unsetting
	\verb\|?circe1_generate\|. In the other examples this flag is
	set, by default. For standard use cases,
	\circeone\ implements a beam-event generator inside the
	\whizard\ generator, which provides beam-event samples with correctly
	distributed probability. For electrons, the beamstrahlung spectrum
	sharply peaks near maximum energy. This distribution is most
	efficiently handled by the generator mode. By contrast, in the $\gamma\gamma$
	mode, the beam-event c.m.\ energy is concentrated at low values. For
	final states with low invariant mass, which are typically produced by
	beamstrahlung photons, the generator mode is appropriate.
	However, the $W^+W^-$ system requires substantial energy, and such
	events will be very rare in the beam-event sample. Switching off the
	\circeone\ generator mode solves this
	problem.

	This is an overview over all options and flags for the \circeone\
	setup for lepton collider beamstrahlung:

	\vspace{2mm}

	\centerline{\begin{tabular}{\|l\|l\|l\|}\hline
	Parameter & Default & Meaning \\\hline\hline
	\ttt{?circe1\_photon1} & \ttt{false} & $e\to\gamma$ conversion for beam 1
	\\\hline
	\ttt{?circe1\_photon2} & \ttt{false} & $e\to\gamma$ conversion for beam 2
	\\\hline
	\ttt{circe1\_sqrts} & $\sqrt{s}$ & collider energy for the beam spectrum \\\hline
	\ttt{?circe1\_generate} & \ttt{true} & flag for the \circeone\ generator mode \\\hline
	\ttt{?circe1\_map} & \ttt{true} & flag to apply special phase-space mapping
	\\\hline
	\ttt{circe1\_mapping\_slope} & \ttt{2.} & value of PS mapping exponent
	\\\hline
	\ttt{circe1\_eps} & \ttt{1E-5} & parameter for mapping of spectrum peak
	position \\\hline
	\ttt{circe1\_ver} & \ttt{0} & internal version of \circeone\ package
	\\\hline
	\ttt{circe1\_rev} & \ttt{0}/most recent & internal revision of
	\circeone\ \\\hline
	\ttt{\$circe1\_acc} & \ttt{SBAND} & accelerator type \\\hline
	\ttt{circe1\_chat} & \ttt{0} & chattiness/verbosity of \circeone \\\hline
	\end{tabular}}\mbox{}

	The collider energy relevant for the beamstrahlung spectrum is set by
	\ttt{circe1\_sqrts}. As a default, this is always the value of
	\ttt{sqrts} set in the \sindarin\ script. However, sometimes these
	values do not match, e.g. the user wants to simulate $t\bar t h$ at
	\ttt{sqrts = 550 GeV}, but the only available beam spectrum is for 500
	GeV. In that case, \ttt{circe1\_sqrts = 500 GeV} has to be set to use
	the closest possible available beam spectrum.

	As mentioned in the discussion of the examples above, in
	\circeone\ there are two options to use the beam spectra for
	beamstrahlung: intrinsic semi-analytic approximation formulae for the
	spectra, or a Monte-Carlo sampling of the sampling. The second
	possibility always give a better description of the spectra, and is
	the default for \whizard. It can, however, be switched off by setting
	the flag \ttt{?circe1\_generate} to \ttt{false}.

	As the beamstrahlung spectra are sharply peaked at the collider
	energy, but still having long tails, a mapping of the spectra for an
	efficient phase-space sampling is almost mandatory. This is the
	default in \whizard, which can be changed by the flag
	\ttt{?circe1\_map}. Also, the default exponent for the mapping can be
	changed from its default value \ttt{2.} with the variable
	\ttt{circe1\_mapping\_slope}. It is important to efficiently sample
	the peak position of the spectrum; the effective ratio of the peak to
	the whole sampling interval can be set by the parameter
	\ttt{circe1\_eps}. The integer parameter \ttt{circe1\_chat} sets the
	chattiness or verbosity of the \circeone\ package, i.e. how many
	messages and warnings from the beamstrahlung generation/sampling will
	be issued.

	The actual internal version and revision of the \circeone\ package are
	set by the two integer parameters \ttt{circe1\_ver} and
	\ttt{circe1\_rev}. The default is in any case always the newest
	version and revision, while older versions are still kept for
	backwards compatibility and regression testing.

	Finally, the geometry and design of the accelerator type is set with
	the string variable \ttt{\$circe1\_acc}: it contains the possible
	options for the old \ttt{"SBAND"} and \ttt{"XBAND"} setups, as well as
	the \ttt{"TESLA"} and JLC/NLC SLAC design \ttt{"JLCNLC"}. The setups
	for the most important energies of the ILC as they are summarized in
	the ILC
	TDR~\cite{Behnke:2013xla,Baer:2013cma,Adolphsen:2013jya,Adolphsen:2013kya}
	are available as \ttt{ILC}. Beam spectra for the
	CLIC~\cite{Aicheler:2012bya,Lebrun:2012hj,Linssen:2012hp} linear
	collider are much more demanding to correctly simulate (due to the
	drive beam concept; only the low-energy modes where the drive beam is
	off can be simulated with the same setup as the abovementioned
	machines). Their setup will be supported soon in one of the upcoming
	\whizard\ versions within the \circetwo\ package.

	An example of how to generate beamstrahlung spectra with the help of
	the package \circetwo\ (that is also a part of \whizard) is this:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	process eemm = e1, E1 => e2, E2
	sqrts = 500 GeV
	beams = e1, E1 => circe2
	$circe2_file = "ilc500.circe"
	$circe2_design = "ILC"
	?circe_polarized = false
	\end{Verbatim}
	\end{footnotesize}%$
	\end{quote}
	Here, the ILC design is used for a beamstrahlung spectrum at 500 GeV
	nominal energy, with polarization averaged (hence, the setting of
	polarization to \ttt{false}). A list of all available options can be
	found in Sec.~\ref{sec:photoncoll}.

	More technical details about the simulation of beamstrahlung spectra
	see the documented source code of the \circeone\ package, as well as
	Chap.~\ref{chap:hardint}. In the next section, we discuss how to read
	in beam spectra from external files.

	%%%%%%%%%%%%%%%

	\subsection{Beam events}
	\label{sec:beamevents}

	As mentioned in the previous section, beamstrahlung is one of the
	crucial ingredients for a realistic simulation of linear lepton
	colliders. One option is to take a pre-generated beam spectrum for
	such a machine, and make it available for simulation within \whizard\
	as an external ASCII data file. Such files basically contain only
	pairs of energy fractions of the nominal collider energy $\sqrt{s}$
	($x$ values). In \whizard\ they can be used in simulation with the
	following \ttt{beams} statement:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	beams = e1, E1 => beam_events
	$beam_events_file = "<beam_spectrum_file>"
	\end{Verbatim}
	\end{footnotesize}%$
	\end{quote}
	Note that beam spectra must always be pair spectra, i.e. they are
	automatically applied to both beam simultaneously.
	Beam spectra via external files are expected to reside in the current
	working directory. Alternatively, \whizard\ searches for them in the
	install directory of \whizard\ in \ttt{share/beam-sim}. There you can
	find an example file, \ttt{uniform\_spread\_2.5\%.dat} for such a beam
	spectrum. The only possible parameter that can be set is the flag
	\ttt{?beam\_events\_warn\_eof} whose default is \ttt{true}. This
	triggers the issuing of a warning when the end of file of an external
	beam spectrum file is reached. In such a case, \whizard\ starts to
	reuse the same file again from the beginning. If the available data
	points in the beam events file are not big enough, this could result
	in an insufficient sampling of the beam spectrum.

	%%%%%%%%%%%%%%%

	\subsection{Gaussian beam-energy spread}
	\label{sec:gaussian}

	Real beams have a small energy spread. If beamstrahlung is small, the spread
	may be approximately described as Gaussian. As a replacement for the full
	simulation that underlies \ttt{CIRCE2} spectra, it is possible to
	impose a Gaussian distributed beam energy, separately for each beam.
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	beams = e1, E1 => gaussian
	gaussian_spread1 = 0.1\%
	gaussian_spread2 = 0.2\%
	\end{Verbatim}
	\end{footnotesize}%$
	\end{quote}
	(Note that the \% sign means multiplication by 0.01, as it should.) The
	spread values are defined as the $\sigma$ value of the Gaussian distribution,
	i.e., $2/3$ of the events are within $\pm 1\sigma$ for each beam,
	respectively.

	%%%%%%%%%%%%%%%%

	\subsection{Equivalent photon approximation}
	\label{sec:epa}

	The equivalent photon approximation (EPA) uses an on-shell approximation for
	the $e \to e\gamma$ collinear splitting to allow the simulation of
	photon-induced backgrounds in lepton collider physics. The original
	concept is that of the Weizs\"acker-Williams
	approximation~\cite{vonWeizsacker:1934sx,Williams:1934ad,Budnev:1974de}. This
	is a single-beam structure function that can be applied to both beams,
	or also to one beam only. Usually, there are some simplifications
	being made in the derivation. The formula which is implemented here
	and seems to be the best for the QCD background for low-$p_T$ hadrons,
	corresponds to Eq.~(6.17) of Ref.~\cite{Budnev:1974de}. As this
	reference already found, this leads to an "overshooting" of accuracy,
	and especially in the high-$x$ (high-energy) region to wrong
	results. This formula corresponds to
	\begin{equation}
	\label{eq:budnev_617}
	f(x) = \frac{\alpha}{\pi} \frac{1}{x} \biggl[ \left( \bar{x} +
	\frac{x^2}{2} \right) \log
	\frac{Q^2_{\text{max}}}{Q^2_{\text{min}}}
	- \left( 1 - \frac{x}{2} \right)^2
	\log \frac{x^2 + \tfrac{Q^2_{\text{max}}}{E^2}}{x^2 +
	\tfrac{Q^2_{\text{min}}}{E^2}}
	- \frac{m_e^2 x^2}{Q^2_{\text{min}}} \left( 1 -
	\frac{Q^2_{\text{min}}}{Q^2_{\text{max}}} \right) \biggr] \qquad .
	\end{equation}
	Here, $x$ is the ratio of the photon energy (called frequency $\omega$
	in~\cite{Budnev:1974de} over the original electron (or positron) beam
	energy $E$. The energy of the electron (or positron) after the
	splitting is given by $\bar{x} = 1-x$.

	The simplified version is the one that corresponds to many
	publications about the EPA during SLC and LEP times, and corresponds
	to the $q^2$ integration of Eq.~(6.16e) in~\cite{Budnev:1974de}, where
	$q^2$ is the virtuality or momentum transfer of the photon in the EPA:
	\begin{equation}
	\label{eq:budnev_616e}
	f(x) = \frac{\alpha}{\pi} \frac{1}{x} \biggl[ \left( \bar{x} +
	\frac{x^2}{2} \right) \log
	\frac{Q^2_{\text{max}}}{Q^2_{\text{min}}}
	- \frac{m_e^2 x^2}{Q^2_{\text{min}}} \left( 1 -
	\frac{Q^2_{\text{min}}}{Q^2_{\text{max}}} \right) \biggr] \qquad .
	\end{equation}
	While Eq.~(\ref{eq:budnev_617}) is supposed to be the better choice
	for simulating hadronic background like low-$p_T$ hadrons and should
	be applied for the low-$x$ region of the EPA,
	Eq.~(\ref{eq:budnev_616e}) seems better suited for high-$x$
	simulations like the photoproduction of BSM resonances etc.
	Note that the first term in Eqs.~(\ref{eq:budnev_617}) and
	(\ref{eq:budnev_616e}) is the standard Altarelli-Parisi QED splitting
	function of electron, $P_{e\to e\gamma}(x) \propto 1 + (1-x)^2$, while
	the last term in both equations is the default power correction.

	The two parameters $Q^2_{\text{max}}$ and $Q^2_{\text{min}}$ are the
	integration boundaries of the photon virtuality integration. Usually,
	they are given by the kinematic limits:
	\begin{equation}
	Q^2_{\text{min}} = \frac{m_e^2 x^2}{\bar{x}} \qquad\qquad
	Q^2_{\text{max}} = 4 E^2 \bar{x} = s \bar{x} \qquad .
	\end{equation}
	For low-$p_T$ hadron simulations, it is not a good idea to take the
	kinematic limit as an upper limit, but one should cut the simulation
	off at a hadronic scale like e.g. a multiple of the $\rho$ mass.

	The user can switch between the two different options using the setting
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	$epa_mode = "default"
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	or
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	$epa_mode = "Budnev_617"
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	for Eq.~(\ref{eq:budnev_617}), while Eq.~(\ref{eq:budnev_616e}) can be
	chosen with
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	$epa_mode = "Budnev_616e"
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	Note that a thorough study for high-energy $e^+e^-$ colliders
	regarding the suitability of different EPA options is still lacking.

	For testing purposes also three more variants or simplifications of
	Eq.~(\ref{eq:budnev_616e}) are implemented: the first, steered by
	\ttt{\$epa\_mode = log\_power} uses simply $Q^2_{\text{max}} =
	s$. This is also the case for the two other method. But the switch
	\ttt{\$epa\_mode = log\_simple} uses just \ttt{epa\_mass} (cf. below)
	as $Q^2_{\text{min}}$. The final simplification is to drop the power
	correction, which can be chosen with \ttt{\$epa\_mode = log}. This
	corresponds to the simple formula:
	\begin{equation}
	f(x) = \frac{\alpha}{2\pi} \frac{1}{x} \, \log\frac{s}{m^2}
	\qquad .
	\end{equation}

	Examples for the application of the EPA in \whizard\ are:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	beams = e1, E1 => epa
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	or for a single beam:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	beams = e1, p => epa, pdf_builtin
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	The last process allows the reaction of (quasi-) on-shell photons with
	protons.

	In the following, we collect the parameters and flags that can be
	adjusted when using the EPA inside \whizard:

	\vspace{2mm}

	\centerline{\begin{tabular}{\|l\|l\|l\|}\hline
	Parameter & Default & Meaning \\\hline\hline
	\ttt{epa\_alpha} & \ttt{0}/intrinsic & value of $\alpha_{QED}$ for EPA
	\\\hline
	\ttt{epa\_x\_min} & \ttt{0.} & soft photon cutoff in $x$ (mandatory)
	\\\hline
	\ttt{epa\_q\_min} & \ttt{0.} & minimal $\gamma$ momentum transfer \\\hline
	\ttt{epa\_mass} & \ttt{0}/intrinsic & mass of the radiating fermion (mandatory) \\\hline
	\ttt{epa\_q\_max} & \ttt{0}/$\sqrt{s}$ & upper cutoff for EPA \\\hline
	\ttt{?epa\_recoil} & \ttt{false} & flag to switch on recoil/$p_T$
	\\\hline
	\ttt{?epa\_keep\_energy} & \ttt{false} & recoil flag to conserve
	energy in splitting
	\\\hline
	\end{tabular}}\mbox{}

	The adjustable parameters are partially similar to the parameters in
	the QED initial-state radiation (ISR), cf. Sec.~\ref{sec:lepton_isr}:
	the parameter \ttt{epa\_alpha} sets the value of the electromagnetic
	coupling constant, $\alpha_{QED}$ used in the EPA structure
	function. If not set, this is taken from the value inside the active
	physics model. The same is true for the mass of the particle that
	radiates the photon of the hard interaction, which can be reset by the
	user with the variable \ttt{epa\_mass}. There are two dimensionful
	scale parameters, the minimal momentum transfer to the photon,
	\ttt{epa\_q\_min}, which must not be zero, and the upper momentum-transfer
	cutoff
	for the EPA structure function, \ttt{epa\_q\_max}. The default for the
	latter value is the collider energy, $\sqrt{s}$, or the energy reduced
	by another structure function like e.g. beamstrahlung,
	$\sqrt{\hat{s}}$. Furthermore, there is a soft-photon regulator for
	the splitting function in $x$ space, \ttt{epa\_x\_min}, which also has
	to be explicitly set different from zero. Hence, a minimal viable
	scenario that will be accepted by \whizard\ looks like this:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	beams = e1, E1 => epa
	epa_q_min = 5 GeV
	epa_x_min = 0.01
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}

	Finally, like the ISR case in Sec.~\ref{sec:lepton_isr}, there is a
	flag to consider the recoil of the photon against the radiating
	electron by setting \ttt{?epa\_recoil} to \ttt{true} (default:
	\ttt{false}).

	Though in principle processes like $e^+ e^- \to e^+ e^- \gamma \gamma$
	where the two photons have been created almost collinearly and then
	initiate a hard process could be described by exact matrix elements
	and exact kinematics. However, the numerical stability in the very far
	collinear kinematics is rather challenging, such that the use of the
	EPA is very often an acceptable trade-off between quality of the
	description on the one hand and numerical stability and speed on the
	other hand.

	In the case, the EPA is set after a second structure function like a
	hadron collider PDF, there is a flavor summation over the quark
	constituents inside the proton, which are then the radiating fermions
	for the EPA. Here, the masses of all fermions have to be identical.

	More about the physics of the equivalent photon approximation can be
	found in Chap.~\ref{chap:hardint}.

	%%%%%%%%%%%%%%%

	\subsection{Effective $W$ approximation}
	\label{sec:ewa}

	An approach similar to the equivalent photon approximation (EPA)
	discussed in the previous section Sec.~\ref{sec:epa}, is the usage
	of a collinear splitting function for the radiation of massive
	electroweak vector bosons $W$/$Z$, the effective $W$ approximation
	(EWA). It has been developed for the
	description of high-energy weak vector-boson fusion and scattering
	processes at hadron colliders, particularly the Superconducting
	Super-Collider (SSC). This was at a time when the simulation of $2\to
	4$ processes war still very challenging and $2\to 6$ processes almost
	impossible, such that this approximation was the only viable solution
	for the simulation of processes like $pp \to jjVV$ and subsequent
	decays of the bosons $V \equiv W, Z$.

	Unlike the EPA, the EWA is much more involved as the structure
	functions do depend on the isospin of the radiating fermions, and are
	also different for transversal and longitudinal polarizations. Also, a
	truely collinear kinematics is never possible due to the finite $W$
	and $Z$ boson masses, which start becoming more and more negligible
	for energies larger than the nominal LHC energy of 14 TeV.

	Though in principle all processes for which the EWA might be
	applicable are technically feasible in \whizard\ to be generated also
	via full matrix elements, the EWA has been implemented in \whizard\
	for testing purposes, backwards compatibility and comparison with
	older simulations. Like the EPA, it is a single-beam structure
	function that can be applied to one or both beams. We only give an
	example for both beams here, this is for a 3 TeV CLIC collider:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	sqrts = 3 TeV
	beams = e1, E1 => ewa
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	And this is for LHC or a higher-energy follow-up collider (which also
	shows the concatenation of the single-beam structure functions,
	applied to both beams consecutively,
	cf. Sec.~\ref{sec:concatenation}:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	sqrts = 14 TeV
	beams = p, p => pdf_builtin => ewa
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}

	Again, we list all the options, parameters and flags that can be
	adapted for the EWA:

	\vspace{2mm}

	\centerline{\begin{tabular}{\|l\|l\|l\|}\hline
	Parameter & Default & Meaning \\\hline\hline
	\ttt{ewa\_x\_min} & \ttt{0.} & soft $W$/$Z$ cutoff in $x$ (mandatory)
	\\\hline
	\ttt{ewa\_mass} & \ttt{0}/intrinsic & mass of the radiating fermion \\\hline
	\ttt{ewa\_pt\_max} & \ttt{0}/$\sqrt{\hat{s}}$ & upper cutoff for EWA \\\hline
	\ttt{?ewa\_recoil} & \ttt{false} & recoil switch
	\\\hline
	\ttt{?ewa\_keep\_energy} & \ttt{false} & energy conservation for
	recoil in splitting
	\\\hline
	\end{tabular}}\mbox{}

	First of all, all coupling constants are taken from the active physics
	model as they have to be consistent with electroweak gauge
	invariance. Like for EPA, there is a soft $x$ cutoff for the $f \to f
	V$ splitting, \ttt{ewa\_x\_min}, that has to be set different from
	zero by the user. Again, the mass of the radiating fermion can be set
	explicitly by the user; and, also again, the masses for the flavor sum
	of quarks after a PDF as radiators of the electroweak bosons have to
	be identical. Also for the EWA, there is an upper cutoff for the $p_T$
	of the electroweak boson, that can be set via
	\ttt{eta\_pt\_max}. Indeed, the transversal $W$/$Z$ structure function
	is logarithmically divergent in that variable. If it is not set by the
	user, it is estimated from $\sqrt{s}$ and the splitting kinematics.

	For the EWA, there is a flag to switch on a recoil for the
	electroweak boson against the radiating fermion,
	\ttt{?ewa\_recoil}. Note that this is an experimental feature that is
	not completely tested. In any case, the non-collinear kinematics
	violates 4-four momentum conservation, so there are two choices:
	either to conserve the energy (\ttt{?ewa\_keep\_energy = true}) or to
	conserve 3-momentum (\ttt{?ewa\_keep\_energy = false}). Momentum
	conservation for the kinematics is the default. This is due to the
	fact that for energy conservation, there will be a net total momentum
	in the event including the beam remnants (ISR/EPA/EWA radiated
	particles) that leeds to unexpected or unphysical features in the
	energy distributions of the beam remnants recoiling against the rest
	of the event.

	More details about the physics can be found in
	Chap.~\ref{chap:hardint}.


	%%%%%%%%%%%%%%%

	\subsection{Energy scans using structure functions}

	In \whizard, there is an implementation of a pair spectrum,
	\ttt{energy\_scan}, that allows to scan the energy dependence of a
	cross section without actually scanning over the collider
	energies. Instead, only a single integration at the upper end of the
	scan interval over the process with an additional pair spectrum
	structure function performed. The structure function is chosen
	in such a way, that the distribution of $x$ values of the energy scan
	pair spectrum translates in a plot over the energy of the final state
	in an energy scan from \ttt{0} to \ttt{sqrts} for the process under
	consideration.

	The simplest example is the $1/s$ fall-off with the $Z$ resonance in
	$e^+e^- \to \mu^+ \mu^-$, where the syntax is very easy:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	process eemm = e1, E1 => e2, E2
	sqrts = 500 GeV
	cuts = sqrts_hat > 50
	beams = e1, E1 => energy_scan
	integrate (eemm)
	\end{Verbatim}
	\end{footnotesize}
	\end{quote}
	The value of \ttt{sqrts = 500 GeV} gives the upper limit for the scan,
	while the cut effectively lets the scan start at 50 GeV. There are no
	adjustable parameters for this structure function. How to plot the
	invariant mass distribution of the final-state muon pair to show the
	energy scan over the cross section, will be explained in
	Sec.~\ref{sec:analysis}.

	More details can be found in Chap.~\ref{chap:hardint}.

	%%%%%%%%%%%%%%%

	\subsection{Photon collider spectra}
	\label{sec:photoncoll}

	One option that has been discussed as an alternative possibility for a
	high-energy linear lepton collider is to convert the electron and
	positron beam via Compton backscattering off intense laser beams into
	photon
	beams~\cite{Ginzburg:1981vm,Telnov:1989sd,Telnov:1995hc}. Naturally,
	due to the production
	of the photon beams and the inherent electron spectrum, the photon
	beams have a characteristic spectrum. The simulation of such spectra
	is possible within \whizard\ by means of the subpackage \circetwo,
	which have been mentioned already in Sec.~\ref{sec:beamstrahlung}. It
	allows to give a much more elaborate description of a linear lepton
	collider environment than
	\circeone\ (which, however, is not in all cases necessary, as the ILC
	beamspectra for electron/positrons can be perfectly well described
	with \circeone).

	Here is a typical photon collider setup where we take a
	photon-initiated process:
	\begin{quote}
	\begin{footnotesize}
	\begin{Verbatim}
	process aaww = A, A => Wp, Wm

	beams = A, A => circe2
	$circe2_file = "teslagg_500_polavg.circe"
	$circe2_design = "TESLA/GG"
	?circe2_polarized = false
	\end{Verbatim}
	\end{footnotesize}%$
	\end{quote}

	Here, the photons are the initial states initiating the hard
	scattering. The structure function is \ttt{circe2} which always is a
	pair spectrum. The list of available options are:

	\vspace{2mm}

	\centerline{\begin{tabular}{\|l\|l\|l\|}\hline
	Parameter & Default & Meaning \\\hline\hline
	\ttt{?circe2\_polarized} & \ttt{true} & spectrum respects polarization info
	\\\hline
	\ttt{\$circe2\_file} & -- & name of beam spectrum data file
	\\\hline
	\ttt{\$circe2\_design} & \ttt{"*"} & collider design
	\\\hline
	\end{tabular}}\mbox{}

	The only logical flag \ttt{?circe2\_polarized} let \whizard\ know
	whether it should keep polarization information in the beam spectra or
	average over polarizations. Naturally, because of the Compton
	backscattering generation of the photons, photon spectra are always
	polarized. The collider design can be specified by the string variable
	\ttt{\$circe2\_design}, where the default setting \ttt{"*"}
	corresponds to the default of \circetwo\ (which is the TESLA 500 GeV
	machine as discussed in the TESLA Technical Design
	Report~\cite{AguilarSaavedra:2001rg,Richard:2001qm}). Note that up to
	now there have not been any setups for a photon collider option for
	the modern linear collider concepts like ILC and CLIC. The string
	variable \ttt{\$circe2\_file} then allows to give the name of the file
	containing the actual beam spectrum; all files that ship with
	\whizard\ are stored in the directory \ttt{circe2/share/data}.

	More details about the subpackage \circetwo\ and the physics it
	covers, can be found in its own manual and the chapter
	Chap.~\ref{chap:hardint}.

	%%%%%%%%%%%%%%%

	\subsection{Concatenation of several structure functions}
	\label{sec:concatenation}

	As has been shown already in Sec.~\ref{sec:epa} and
	Sec.~\ref{sec:ewa}, it is possible within \whizard\ to concatenate
	more than one structure function, irrespective of the fact, whether
	the structure functions are single-beam structure functions or pair
	spectra. One important thing is whether there is a phase-space mapping
	for these structure functions. Also, there are some combinations which
	do not make sense from the physics point of view, for example using
	lepton-collider ISR for protons, and then afterwards switching on
	PDFs. Such combinations will be vetoed by \whizard, and you will find
	an error message like (cf. also Sec.~\ref{sec:errors}):
	\begin{interaction}
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Beam structure: [....] not supported
	******************************************************************************
	******************************************************************************
	\end{interaction}

	Common examples for the concatenation of structure functions are
	linear collider applications, where beamstrahlung (macroscopic
	electromagnetic beam-beam interactions) and electron QED initial-state
	radiation are both switched on:
	\begin{code}
	beams = e1, E1 => circe1 => isr
	\end{code}
	Another possibility is the simulation of photon-induced backgrounds at
	ILC or CLIC, using beamstrahlung and equivalent photon approximation
	(EPA):
	\begin{code}
	beams = e1, E1 => circe1 => epa
	\end{code}
	or with beam events from a data file:
	\begin{code}
	beams = e1, E1 => beam_events => isr
	\end{code}

	In hadron collider physics, parton distribution functions (PDFs) are
	basically always switched on, while afterwards the user could specify
	to use the effective $W$ approximation (EWA) to simulate high-energy
	vector boson scattering:
	\begin{code}
	sqrts = 100 TeV
	beams = p, p => pdf_builtin => ewa
	\end{code}
	Note that this last case involves a flavor sum over the five active
	quark (and anti-quark) species $u$, $d$, $c$, $s$, $b$ in the proton,
	all of which act as radiators for the electroweak vector bosons in the
	EWA.

	This would be an example with three structure functions:
	\begin{code}
	beams = e1, E1 => circe1 => isr => epa
	\end{code}

	%%%%%%%%%%%%%%%

	\section{Polarization}
	\label{sec:polarization}

	%%%%%

	\subsection{Initial state polarization}
	\label{sec:initialpolarization}

	\whizard\ supports polarizing the inital state fully or partially by
	assigning a nontrivial density matrix in helicity space.
	Initial state polarization requires a beam setup and is initialized by
	means of the \ttt{beams\_pol\_density} statement\footnote{Note that
	the syntax for the specification of beam polarization has changed
	from version v2.1 to v2.2 and is incompatible between the two
	release series. The old syntax \ttt{beam\_polarization} with its
	different polarization constructors has been discarded in favor of a
	unified syntax.}:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams_pol_density = @([<spin entries>]), @([<spin entries>])
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	The command \ttt{beams\_pol\_fraction} gives the degree of
	polarization of the two beams:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams_pol_fraction = <degree beam 1>, <degree beam 2>
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Both commands in the form written above apply to scattering processes,
	where the polarization of both beams must be specified. The
	\ttt{beams\_pol\_density} and \ttt{beams\_pol\_fraction} are possible
	with a single beam declaration if a decay process is considered, but
	only then.

	While the syntax for the command \ttt{beams\_pol\_fraction} is pretty
	obvious, the syntax for the actual specification of the beam
	polarization is more intricate. We start with the polarization
	fraction: for each beam there is a real number between zero
	(unpolarized) and one (complete polarization) that can be specified
	either as a floating point number like \ttt{0.4} or with a percentage:
	\ttt{40 \%}. Note that the actual arithmetics is sometimes
	counterintuitive: 80 \% left-handed electron polarization means that
	80 \% of the electron beam are polarized, 20 \% are unpolarized,
	i.e. 20 \% have half left- and half right-handed polarization
	each. Hence, 90 \% of the electron beam is left-handed, 10 \% is
	right-handed.

	How does the specification of the polarization work? If there are no
	entries at all in the polarization constructor, \ttt{@()}, the beam is
	unpolarized, and the spin density matrix is proportional to the
	unit/identity matrix. Placing entries into the \ttt{@()} constructor
	follows the concept of sparse matrices, i.e. the entries that have
	been specified will be present, while the rest remains zero. Single
	numbers do specify entries for that particular helicity on the main
	diagonal of the spin density matrix, e.g. for an electron \ttt{@(-1)}
	means (100\%) left-handed polarization. Different entries are
	separated by commas: \ttt{@(1,-1)} sets the two diagonal entries at
	positions $(1,1)$ and $(-1,-1)$ in the density matrix both equal to
	one. Two remarks are in order
	already here. First, note that you do not have to worry about the
	correct normalization of the spin density matrix, \whizard\ is taking
	care of this automatically. Second, in the screen output for the beam
	data, only those entries of the spin density matrix that have been
	specified by the user, will be displayed. If a
	\ttt{beams\_pol\_fraction} statement appears, other components will be
	non-zero, but might not be shown. E.g. ILC-like, 80 \% polarization of
	the electrons, 30 \% positron polarization will be specified like this
	for left-handed electrons and right-handed positrons:
	\begin{code}
	beams = e1, E1
	beams_pol_density = @(-1), @(+1)
	beams_pol_fraction = 80%, 30%
	\end{code}
	The screen output will be like this:
	\begin{code}
	\| ------------------------------------------------------------------------
	\| Beam structure: e-, e+
	\| polarization (beam 1):
	\| @(-1: -1: ( 1.000000000000E+00, 0.000000000000E+00))
	\| polarization (beam 2):
	\| @(+1: +1: ( 1.000000000000E+00, 0.000000000000E+00))
	\| polarization degree = 0.8000000, 0.3000000
	\| Beam data (collision):
	\| e- (mass = 0.0000000E+00 GeV) polarized
	\| e+ (mass = 0.0000000E+00 GeV) polarized
	\end{code}
	But because of the fraction of unpolarized electrons and positrons,
	the spin density matrices for electrons and positrons are:
	\[
	\rho(e^-) = \diag \left ( 0.10, 0.90 \right) \qquad
	\rho(e^+) = \diag \left ( 0.65, 0.35 \right) \quad ,
	\]
	respectively. So, in general, only the entries due to the polarized
	fraction will be displayed on screen. We will come back to more
	examples below.

	Again, the setting of a single entry, e.g. \ttt{@($\pm m$)}, which
	always sets the diagonal component $(\pm m, \pm m)$ of the spin
	density matrix equal to one. Here $m$ can have the following values
	for the different spins (in parentheses are entries that exist only
	for massive particles):

	\vspace{1mm}

	\begin{center}
	\begin{tabular}{\|l\|l\|l\|}\hline
	Spin $j$ & Particle type & possible $m$ values \\\hline
	0 & Scalar boson & 0 \\
	1/2 & Spinor & +1, -1 \\
	1 & (Massive) Vector boson & +1, (0), -1 \\
	3/2 & (Massive) Vectorspinor & +2, (+1), (-1), -2 \\
	2 & (Massive) Tensor & +2, (+1), (0), (-1), -2
	\\\hline
	\end{tabular}
	\end{center}

	\vspace{1mm}

	Off-diagonal entries that are equal to one (up to the normalization)
	of the spin-density matrix can be specified simply by the position,
	namely: \ttt{@($m$:$m'$, $m''$)}. This would result in a spin density
	matrix with diagonal entry $1$ for the position $(m'', m'')$, and an entry
	of $1$ for the off-diagonal position $(m,m')$.

	Furthermore, entries in the density matrix different from $1$ with a
	numerical value \ttt{{\em <val>}} can be
	specified, separated by another colon: \ttt{@($m$:$m'$:{\em
	<val>})}. Here, it does not matter whether $m$ and $m'$ are different
	or not. For $m = m'$ also diagonal spin density matrix entries
	different from one can be specified. Note that because spin density
	matrices have to be Hermitian, only the entry $(m,m')$ has to be set,
	while the complex conjugate entry at the transposed position $(m',m)$
	is set automatically by \whizard.

	We will give some general density
	matrices now, and after that a few more definite examples. In the
	general setups below, we always give the expression for the spin
	density matrix only for one single beam.
	%
	{

	\newcommand{\cssparse}[4]{%
	\begin{pmatrix}
	#1 & 0 & \cdots & \cdots & #3 \\
	0 & 0 & \ddots & & 0 \\
	\vdots & \ddots & \ddots & \ddots & \vdots \\
	0 & & \ddots & 0 & 0 \\
	#4 & \cdots & \cdots & 0 & #2
	\end{pmatrix}%
	}
	%

	\begin{itemize}
	\item {\bf Unpolarized:}
	\begin{center}
	\begin{footnotesize}
	\ttt{beams\_pol\_density = @()}
	\end{footnotesize}
	\end{center}
	% \newline
	This has the same effect as not specifying any
	polarization at all and is the only constructor available for scalars and
	fermions declared as left- or right-handed (like the neutrino). Density matrix:
	\[ \rho = \frac{1}{\|m\|}\mathbb{I} \]
	($\|m\|$: particle multiplicity which is 2 for massless, $2j + 1$ for massive particles).
	%
	\item {\bf Circular polarization:}
	\begin{center}
	\begin{footnotesize}
	\ttt{beams\_pol\_density = @($\pm j$) \qquad beams\_pol\_fraction
	= $f$}
	\end{footnotesize}
	\end{center}
	A fraction $f$ (parameter range $f \in \left[0\;;\;1\right]$) of
	the particles are in the maximum / minimum helicity eigenstate $\pm
	j$, the remainder is unpolarized. For spin $\frac{1}{2}$ and massless
	particles of spin $>0$, only the maximal / minimal entries of the
	density matrix are populated, and the density matrix looks like this:
	\[ \rho = \diag\left(\frac{1\pm f}{2}\;,\;0\;,\;\dots\;,\;0\;,
	\frac{1\mp f}{2}\right) \]
	%
	\item {\bf Longitudinal polarization (massive):}
	\begin{center}
	\begin{footnotesize}
	\ttt{beams\_pol\_density = @(0) \qquad beams\_pol\_fraction = $f$}
	\end{footnotesize}
	\end{center}
	We consider massive particles with maximal spin component $j$, a
	fraction $f$ of which having longitudinal polarization, the remainder
	is unpolarized. Longitudinal polarization is (obviously) only
	available for massive bosons of spin $>0$. Again, the parameter range
	for the fraction is: $f \in \left[0\;;\;1\right]$. The density matrix
	has the form:
	\[ \rho = \diag\left(\frac{1-f}{\|m\|}\;,\;\dots\;,\;\frac{1-f}{\|m\|}\;,\;
	\frac{1+f \left(\|m\| - 1\right)}{\|m\|}\;,\;\frac{1-f}{\|m\|}\;,
	\;\dots\;,\;\frac{1-f}{\|m\|}\right)
	\]
	($\|m\| = 2j+1 $: particle multiplicity)
	%
	\item {\bf Transverse polarization (along an axis):}
	\begin{center}
	\begin{footnotesize}
	\ttt{beams\_pol\_density = @(j, -j, j:-j:exp(-I*phi)) \qquad
	beams\_pol\_fraction = $f$}
	\end{footnotesize}
	\end{center}
	This so called transverse polarization is a polarization along an
	arbitrary direction in the $x-y$ plane, with $\phi=0$ being the positive
	$x$ direction and $\phi=90^\circ$ the positive $y$ direction. Note that
	the value of \ttt{phi} has either to be set inside the beam
	polarization expression explicitly or by a statement \ttt{real phi =
	{\em val} degree} before. A fraction $f$ of the particles are
	polarized, the remainder is unpolarized. Note that, although
	this yields a valid density matrix for all particles with multiplicity
	$>1$ (in which the only the highest and lowest helicity states are
	populated), it is meaningful only for spin $\frac{1}{2}$ particles and
	massless bosons of spin $>0$. The range of the parameters are:
	$f \in \left[0\;;\;1\right]$ and $\phi \in \mathbb{R}$. This yields a
	density matrix:
	\[ \rho =
	\cssparse{1}{1}
	{\frac{f}{2}\,e^{-i\phi}} {\frac{f}{2}\,e^{i\phi}} \]
	(for antiparticles, the matrix is conjugated).
	%
	\item {\bf Polarization along arbitrary axis $\left(\theta, \phi\right)$:}
	\begin{center}
	\begin{footnotesize}
	\ttt{beams\_pol\_density = @(j:j:1-cos(theta),
	j:-j:sin(theta)exp(-Iphi), -j:-j:1+cos(theta))} \qquad\quad\qquad
	\ttt{beams\_pol\_fraction = $f$}
	\end{footnotesize}
	\end{center}
	This example describes polarization along an arbitrary axis in polar
	coordinates (polar axis in positive $z$ direction, polar angle
	$\theta$, azimuthal angle $\phi$). A fraction $f$ of the particles are
	polarized, the remainder is unpolarized. Note that, although axis
	polarization defines a valid density matrix for all particles with
	multiplicity $>1$, it is meaningful only for particles with spin
	$\frac{1}{2}$. Valid ranges for the parameters are $f \in
	\left[0\;;\;1\right]$, $\theta \in \mathbb{R}$, $\phi \in
	\mathbb{R}$. The density matrix then has the form:
	\[ \rho = \frac{1}{2}\cdot
	\cssparse{1 - f\cos\theta}{1 + f\cos\theta}
	{f\sin\theta\, e^{-i\phi}}{f\sin\theta\, e^{i\phi}}
	\]
	%
	\item {\bf Diagonal density matrix:}
	\begin{center}
	\begin{footnotesize}
	\ttt{beams\_pol\_density = @(j:j:$h_j$, j-1:j-1:$h_{j-1}$,
	$\ldots$, -j:-j:$h_{-j}$)}
	\end{footnotesize}
	\end{center}
	This defines an arbitrary diagonal density matrix with entries
	$\rho_{j,j}\,,\,\dots\,,\,\rho_{-j,-j}$.
	%
	\item {\bf Arbitrary density matrix:}
	\begin{center}
	\begin{footnotesize}
	\ttt{beams\_pol\_density = @($\{m:m':x_{m,m'}\}$)}:
	\end{footnotesize}
	\end{center}
	Here, \ttt{$\{m:m':x_{m,m'}\}$} denotes a selection of entries at
	various positions somewhere in the spin density matrix. \whizard\
	will check whether this is a valid spin density matrix, but it does
	e.g. not have to correspond to a pure state.
	%
	\end{itemize}
	}
	%

	The beam polarization statements can be used both globally directly
	with the \ttt{beams} specification, or locally inside the
	\ttt{integrate} or \ttt{simulate} command. Some more specific examples
	are in order to show how initial state polarization works:
	%
	\begin{itemize}
	\item
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = A, A
	beams_pol_density = @(+1), @(1, -1, 1:-1:-I)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This declares the initial state to be composed of two incoming
	photons, where the first photon is right-handed, and the second photon
	has transverse polarization in $y$ direction.
	%
	\item
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = A, A
	beams_pol_density = @(+1), @(1, -1, 1:-1:-1)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Same as before, but this time the second photon has transverse
	polarization in $x$ direction.

	%
	\item
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = "W+"
	beams_pol\_density = @(0)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This example sets up the decay of a longitudinal vector boson.
	%
	\item
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	beams = E1, e1
	scan int hel_ep = (-1, 1) {
	scan int hel_em = (-1, 1) {
	beams_pol_density = @(hel_ep), @(hel_em)
	integrate (eeww)
	}
	}
	integrate (eeww)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This example loops over the different positron and electron helicity
	combinations and calculates the respective integrals. The
	\ttt{beams\_pol\_density} statement is local to the scan loop(s) and,
	therefore, the last \ttt{integrate} calculates the unpolarized
	integral.
	\end{itemize}
	%

	Although beam polarization should be straightforward to use, some pitfalls exist
	for the unwary:
	\begin{itemize}
	\item Once \ttt{beams\_pol\_density} is set globally, it persists and
	is applied every time \ttt{beams} is executed (unless it is reset). In
	particular, this means that code like
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	process wwaa = Wp, Wm => A, A
	process zee = Z => e1, E1

	sqrts = 200 GeV
	beams_pol_density = @(1, -1, 1:-1:-1), @()
	beams = Wp, Wm
	integrate (wwaa)
	beams = Z
	integrate (zee)
	beams_pol_density = @(0)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	will throw an error, because \whizard\ complains that the spin density
	matrix has the wrong dimensionality for the second (the decay) process.
	This kind of trap can be avoided be using \ttt{beams\_pol\_density}
	only locally in \ttt{integrate} or \ttt{simulate} statements.
	%
	\item On-the-fly integrations executed by \ttt{simulate}
	use the beam
	setup found at the point of execution. This implies that any polarization
	settings you have previously done affect the result of the integration.
	%
	\item The \ttt{unstable} command also requires integrals of the selected decay
	processes, and will compute them on-the-fly if they are unavailable. Here,
	a polarized integral is not meaningful at all. Therefore, this command
	ignores the current \ttt{beam} setting and issues a warning if a previous
	polarized integral is available; this will be discarded.
	\end{itemize}


	\subsection{Final state polarization}

	Final state polarization is available in \whizard\ in the sense that the
	polarization of real final state particles can be retained when generating
	simulated
	events. In order for the polarization of a particle to be retained, it must be
	declared as polarized via the \ttt{polarized} statement
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	polarized particle [, particle, ...]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	The effect of \ttt{polarized} can be reversed with the \ttt{unpolarized}
	statement which has the same syntax. For example,
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	polarized "W+", "W-", Z
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	will cause the polarization of all final state $W$ and $Z$ bosons to be
	retained, while
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	unpolarized "W+", "W-", Z
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	will reverse the effect and cause the polarization to be summed over again. Note
	that \ttt{polarized} and \ttt{unpolarized} are global statements which cannot be
	used locally as command arguments and if you use them e.g. in a loop, the
	effects will persist beyond the loop body. Also, a particle cannot be
	\ttt{polarized} and \ttt{unstable} at the same time (this restriction
	might be loosened in future versions of \whizard).

	After toggling the polarization flag, the generation of polarized events can be
	requested by using the \ttt{?polarized\_events} option of the \ttt{simulate}
	command, e.g.
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	simulate (eeww) { ?polarized_events = true }
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	When \ttt{simulate} is run in this mode, helicity information for final state
	particles that have been toggled as \ttt{polarized} is written to the event
	file(s) (provided that polarization is supported by the selected event file
	format(s) ) and can also be accessed in the analysis by means of the \ttt{Hel}
	observable. For example, an analysis definition like
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	analysis =
	if (all Hel == -1 ["W+"] and all Hel == -1 ["W-"] ) then
	record cta_nn (eval cos (Theta) ["W+"]) endif;
	if (all Hel == -1 ["W+"] and all Hel == 0 ["W-"] )
	then record cta_nl (eval cos (Theta) ["W+"]) endif
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	can be used to histogram the angular distribution for the production of
	polarized $W$ pairs (obviously, the example would have to be extended
	to cover all possible helicity combinations). Note, however, that
	helicity information is not available in the integration step;
	therefore, it is not possible to use \ttt{Hel} as a cut observable.

	While final state polarization is straightforward to use, there is a caveat when
	used in combination with flavor products. If a particle in a flavor product is
	defined as \ttt{polarized}, then all particles ``originating'' from the product will
	act as if they had been declared as \ttt{polarized} --- their polarization will
	be recorded in the generated events. E.g., the example
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	process test = u:d, ubar:dbar => d:u, dbar:ubar, u, ubar

	! insert compilation, cuts and integration here

	polarized d, dbar
	simulate (test) {?polarized_events = true}
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	will generate events including helicity information for all final state $d$ and
	$\overline{d}$ quarks, but only for part of the final state $u$ and $\overline{u}$
	quarks. In this case, if you had wanted to keep the helicity information also
	for all $u$ and $\overline{u}$, you would have had to explicitely include them
	into the \ttt{polarized} statement.


	\section{Cross sections}

	Integrating matrix elements over phase space is the core of \whizard's
	activities. For any process where we want the cross section, distributions,
	or event samples, the cross section has to be determined first. This is done
	by a doubly adaptive multi-channel Monte-Carlo integration. The integration,
	in turn, requires a \emph{phase-space setup}, i.e., a collection of
	phase-space \emph{channels}, which are mappings of the unit hypercube onto the
	complete space of multi-particle kinematics. This phase-space information is
	encoded in the file \emph{xxx}\ttt{.phs}, where \emph{xxx} is the process tag.
	\whizard\ generates the phase-space file on the fly and can reuse it in later
	integrations.

	For each phase-space channel, the unit hypercube is binned in each dimension.
	The bin boundaries are allowed to move during a sequence of iterations, each
	with a fixed number of sampled phase-space points, so they adapt to the actual
	phase-space density as far as possible. In addition to this \emph{intrinsic}
	adaptation, the relative channel weights are also allowed to vary.

	All these steps are done automatically when the \ttt{integrate} command is
	executed. At the end of the iterative adaptation procedure, the program has
	obtained an estimate for the integral of the matrix element over phase space,
	together with an error estimate, and a set of integration \emph{grids} which
	contains all information on channel weights and bin boundaries. This
	information is stored in a file \emph{xxx}\ttt{.vg}, where \emph{xxx} is the
	process tag, and is used for event generation by the \ttt{simulate}
	command.


	\subsection{Integration}
	\label{sec:integrate}

	Since everything can be handled automatically using default parameters, it
	often suffices to write the command
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	integrate (proc1)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	for integrating the process with name tag \ttt{proc1}, and similarly
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	integrate (proc1, proc2, proc3)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	for integrating several processes consecutively. Options to the integrate
	command are specified, if not globally, by a local option string
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	integrate (proc1, proc2, proc3) { mH = 200 GeV }
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	(It is possible to place a \ttt{beams} statement inside the option string, if
	desired.)

	If the process is configured but not compiled, compilation will be done
	automatically. If it is not available at all, integration will fail.

	The integration method can be specified by the string variable
	\begin{quote}
	\begin{footnotesize}
	\ttt{\$integration\_method = "{\em <method>}"}
	\end{footnotesize}
	\end{quote} %$
	The default method is called \ttt{"vamp"} and uses the \vamp\
	algorithm and code. (At the moment, there is only a single simplistic
	alternative, using the midpoint rule or rectangle method for
	integration, \ttt{"midpoint"}. This is mainly for testing purposes. In
	future versions of \whizard, more methods like e.g. Gauss integration
	will be made available). \vamp, however, is clearly the main
	integration method. It is done in several \emph{passes} (usually two),
	and each pass consists of several \emph{iterations}. An iteration
	consists of a definite number of \emph{calls} to the matrix-element
	function.

	For each iteration, \whizard\ computes an estimate of the integral and an
	estimate of the error, based on the binned sums of matrix element values and
	squares. It also computes an estimate of the rejection efficiency for
	generating unweighted events, i.e., the ratio of the average sampling function
	value over the maximum value of this function.

	After each iteration, both the integration grids (the binnings) and the
	relative weights of the integration channels can be adapted to
	minimize the variance estimate of the integral. After each pass of several
	iterations, \whizard\ computes an average of the iterations within the pass,
	the corresponding error estimate, and a $\chi^2$ value. The integral, error,
	efficiency and $\chi^2$ value computed for the most recent integration pass,
	together with the most recent integration grid, are used for any subsequent
	calculation that involves this process, in particular for event generation.

	In the default setup, during the first pass(es) both grid binnings and channel
	weights are adapted. In the final (usually second) pass, only binnings are
	further adapted. Roughly speaking, the final pass is the actual calculation,
	while the previous pass(es) are used for ``warming up'' the integration grids,
	without using the numerical results. Below, in the section about the
	specification of the iterations, Sec.~\ref{sec:iterations}, we will
	explain how it is possible to change the behavior of adapting grids
	and weights.

	Here is an example of the integration output, which illustrates these
	properties. The \sindarin\ script describes the process $e^+e^-\to q\bar q
	q\bar q$ with $q$ being any light quark, i.e., $W^+W^-$ and $ZZ$ production
	and hadronic decay together will any irreducible background. We cut on $p_T$
	and energy of jets, and on the invariant mass of jet pairs. Here is the
	script:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	alias q = d:u:s:c
	alias Q = D:U:S:C
	process proc_4f = e1, E1 => q, Q, q, Q

	ms = 0 mc = 0
	sqrts = 500 GeV
	cuts = all (Pt > 10 GeV and E > 10 GeV) [q:Q]
	and all M > 10 GeV [q:Q, q:Q]

	integrate (proc_4f)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	After the run is finished, the integration output looks like
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	\| Process library 'default_lib': loading
	\| Process library 'default_lib': ... success.
	\| Integrate: compilation done
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 12511
	\| Initializing integration for process proc_4f:
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'proc_4f'
	\| Library name = 'default_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'proc_4f_i1': e-, e+ => d:u:s:c, dbar:ubar:sbar:cbar,
	\| d:u:s:c, dbar:ubar:sbar:cbar [omega]
	\| ------------------------------------------------------------------------
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e- (mass = 5.1099700E-04 GeV)
	\| e+ (mass = 5.1099700E-04 GeV)
	\| sqrts = 5.000000000000E+02 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'proc_4f_i1.phs'
	\| Phase space: 123 channels, 8 dimensions
	\| Phase space: found 123 channels, collected in 15 groves.
	\| Phase space: Using 195 equivalences between channels.
	\| Phase space: wood
	\| Applying user-defined cuts.
	\| OpenMP: Using 8 threads
	\| Starting integration for process 'proc_4f'
	\| Integrate: iterations not specified, using default
	\| Integrate: iterations = 10:10000:"gw", 5:20000:""
	\| Integrator: 15 chains, 123 channels, 8 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 10000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 9963 2.3797857E+03 3.37E+02 14.15 14.13* 4.02
	2 9887 2.8307603E+03 9.58E+01 3.39 3.37* 4.31
	3 9815 3.0132091E+03 5.10E+01 1.69 1.68* 8.37
	4 9754 2.9314937E+03 3.64E+01 1.24 1.23* 10.65
	5 9704 2.9088284E+03 3.40E+01 1.17 1.15* 12.99
	6 9639 2.9725788E+03 3.53E+01 1.19 1.17 15.34
	7 9583 2.9812484E+03 3.10E+01 1.04 1.02* 17.97
	8 9521 2.9295139E+03 2.88E+01 0.98 0.96* 22.27
	9 9435 2.9749262E+03 2.94E+01 0.99 0.96 20.25
	10 9376 2.9563369E+03 3.01E+01 1.02 0.99 21.10
	\|-----------------------------------------------------------------------------\|
	10 96677 2.9525019E+03 1.16E+01 0.39 1.22 21.10 1.15 10
	\|-----------------------------------------------------------------------------\|
	11 19945 2.9599072E+03 2.13E+01 0.72 1.02 15.03
	12 19945 2.9367733E+03 1.99E+01 0.68 0.96* 12.68
	13 19945 2.9487747E+03 2.03E+01 0.69 0.97 11.63
	14 19945 2.9777794E+03 2.03E+01 0.68 0.96* 11.19
	15 19945 2.9246612E+03 1.95E+01 0.67 0.94* 10.34
	\|-----------------------------------------------------------------------------\|
	15 99725 2.9488622E+03 9.04E+00 0.31 0.97 10.34 1.05 5
	\|=============================================================================\|
	\| Time estimate for generating 10000 events: 0d:00h:00m:51s
	\| Creating integration history display proc_4f-history.ps and proc_4f-history.pdf
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Each row shows the index of a single iteration, the number of matrix element
	calls for that iteration, and the integral and error estimate. Note
	that the number of calls displayed are the real calls to the matrix
	elements after all cuts and possible rejections. The error
	should be viewed as the $1\sigma$ uncertainty, computed on a statistical
	\begin{figure}
	\centering
	\includegraphics[width=.56\textwidth]{proc_4f-history}
	\caption{\label{fig:inthistory} Graphical output of the convergence
	of the adaptation during the integration of a \whizard\ process.}
	\end{figure}
	basis. The next two columns display the error in percent, and the
	\emph{accuracy} which is the same error normalized by $\sqrt{n_{\rm calls}}$.
	The accuracy value has the property that it is independent of $n_{\rm calls}$,
	it describes the quality of adaptation of the current grids. Good-quality
	grids have a number of order one, the smaller the better. The next column is
	the estimate for the rejection efficiency in percent. Here, the value should
	be as high as possible, with $100\,\%$ being the possible maximum.

	In the example, the grids are adapted over ten iterations, after which the
	accuracy and efficiency have saturated at about $1.0$ and $10\,\%$,
	respectively. The asterisk in the accuracy column marks those iterations
	where an improvement over the previous iteration is seen. The average over
	these iterations exhibits an accuracy of $1.22$, corresponding to $0.39\,\%$
	error, and a $\chi^2$ value of $1.15$, which is just right:
	apparently, the phase-space for this process and set of cuts is
	well-behaved. The subsequent five iterations are used for obtaining
	the final integral, which has an accuracy below one (error $0.3\,\%$),
	while the efficiency settles at about
	$10\,\%$. In this example, the final $\chi^2$ value happens to be quite
	small, i.e., the individual results are closer together than the error
	estimates would suggest. One should nevertheless not scale down the error,
	but rather scale it up if the $\chi^2$ result happens to be much larger than
	unity: this often indicates sub-optimally adapted grids, which insufficiently
	map some corner of phase space.

	One should note that all values are subject to statistical fluctuations, since
	the number of calls within each iterations is finite. Typically, fluctuations
	in the efficiency estimate are considerably larger than fluctuations in the
	error/accuracy estimate. Two subsequent runs of the same script should yield
	statistically independent results which may differ in all quantities, within
	the error estimates, since the seed of the random-number generator will differ
	by default.

	It is possible to get exactly reproducible results by setting the
	random-number seed explicitly, e.g.,
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	seed = 12345
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	at any point in the \sindarin\ script. \ttt{seed} is a predefined intrinsic
	variable. The value can be any 32bit integer. Two runs with different seeds
	can be safely taken as statistically independent. In the example
	above, no seed has been set, and the seed has therefore been
	determined internally by \whizard\ from the system clock.

	The concluding line with the time estimate applies to a subsequent simulation
	step with unweighted events, which is not actually requested in the current
	example. It is based on the timing and efficiency estimate of the most recent
	iteration.

	As a default, a graphical output of the integration history will be
	produced (if both \LaTeX\ and \metapost\ have been available during
	configuration). Fig.~\ref{fig:inthistory} shows how this looks like,
	and demonstrates how a proper convergence of the integral during the
	adaptation looks like. The generation of these graphical history files
	can be switched off using the command \ttt{?vis\_history = false}.

	%%%%%

	\subsection{Integration run IDs}

	A single \sindarin\ script may contain multiple calls to the
	\ttt{integrate} command with different parameters. By default,
	files generated for the same process in a subsequent integration will
	overwrite the previous ones. This is undesirable when the script is
	re-run: all results that have been overwritten have to be recreated.

	To avoid this, the user may identify a specific run by a string-valued
	ID, e.g.
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	integrate (foo) { $run_id = "first" }
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This ID will become part of the file name for all files that are
	created specifically for this run. Often it is useful to create a run
	ID from a numerical value using \ttt{sprintf}, e.g., in this scan:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	scan real mh = (100 => 200 /+ 10) {
	$run_id = sprintf "%e" (mh)
	integrate (h_production)
	}
	\end{verbatim}
	\end{footnotesize}
	\end{quote}

	With unique run IDs, a subsequent run of the same \sindarin\ script
	will be able to reuse all previous results, even if there is more than
	a single integration per process.




	\subsection{Controlling iterations}
	\label{sec:iterations}

	\whizard\ has some predefined numbers of iterations and calls for the first
	and second integration pass, respectively, which depend on the number of
	initial and final-state particles. They are guesses for values that yield
	good-quality grids and error values in standard situations, where no
	exceptionally strong peaks or loose cuts are present in the integrand.
	Actually, the large number of warmup iterations in the previous example
	indicates some safety margin in that respect.

	It is possible, and often advisable, to adjust the iteration and call numbers
	to the particular situation. One may reduce the default numbers to short-cut
	the integration, if either less accuracy is needed, or CPU time is to be
	saved. Otherwise, if convergence is bad, the number of iterations or calls
	might be increased.

	To set iterations manually, there is the \ttt{iterations} command:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	iterations = 5:50000, 3:100000
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This is a comma-separated list. Each pair of values corresponds to an
	integration pass. The value before the colon is the number of iterations for
	this pass, the other number is the number of calls per iteration.

	While the default number of passes is two (one for warmup, one for the final
	result), you may specify a single pass
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	iterations = 5:100000
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	where the relative channel weights will \emph{not} be adjusted (because this
	is the final pass). This is appropriate for well-behaved integrands where
	weight adaptation is not necessary.

	You can also define more than two passes. That might be useful when reusing a
	previous grid file with insufficient quality: specify the previous passes
	as-is, so the previous results will be read in, and then a new pass for
	further adaptation.

	In the final pass, the default behavior is to not adapt grids and
	weights anymore. Otherwise, different iterations would be correlated,
	and a final reliable error estimate would not be possible. For all but
	the final passes, the user can decide whether to adapt grids and
	weights by attaching a string specifier to the number of iterations:
	\ttt{"g"} does adapt grids, but not weights, \ttt{"w"} the other way
	round. \ttt{"gw"} or \ttt{"wg"} does adapt both. By the setting
	\ttt{""}, all adaptations are switched off. An example looks like
	this:
	\begin{code}
	iterations = 2:10000:"gw", 3:5000
	\end{code}

	Since it is often not known beforehand how many iterations the grid
	adaptation will need, it is generally a good idea to give the first
	pass a large number of iterations. However, in many cases these turn
	out to be not necessary. To shortcut iterations, you can set any of
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	accuracy_goal
	error_goal
	relative_error_goal
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	to a positive value. If this is done, \whizard\ will skip warmup
	iterations once all of the specified goals are reached by the current
	iteration. The final iterations (without weight adaptation) are
	always performed.


	\subsection{Phase space}

	Before \ttt{integrate} can start its work, it must have a phase-space
	configuration for the process at hand. The method for the phase-space
	parameterization is determined by the string variable
	\ttt{\$phs\_method}. At the moment there are only two options,
	\ttt{"single"}, for testing purposes, that is mainly used internally,
	and \whizard's traditional method, \ttt{"wood"}. This parameterization
	is particularly adapted and fine-tuned for electroweak processes and
	might not be the ideal for for pure jet cross sections. In future
	versions of \whizard, more options for phase-space parameterizations
	will be made available, e.g. the \ttt{RAMBO} algorithm and its massive
	cousin, and phase-space parameterizations that take care of the
	dipole-like emission structure in collinear QCD (or QED) splittings.
	For the standard method, the phase-space parameterization is laid out
	in an ASCII file \ttt{\textit{<process-name>\_}i\textit{<comp>}.phs}.
	Here, \ttt{{\em <process-name>}} is the process name chosen by the
	user while \ttt{{\em <comp>}} is the number of the process component
	of the corresponding process. This immediately shows that different
	components of processes are getting different phase space setups. This
	is necessary for inclusive processes, e.g. the sum of $pp \to Z + nj$
	and $pp \to W + nj$, or in future versions of \whizard\ for NLO
	processes, where one component is the interference between the virtual
	and the Born matrix element, and another one is the subtraction terms.
	Normally, you do not have to deal with this file, since \whizard\ will
	generate one automatically if it does not find one. (\whizard\ is
	careful to check for consistency of process definition and parameters
	before using an existing file.)

	Experts might find it useful to generate a phase-space file and inspect and/or
	modify it before proceeding further. To this end, there is the parameter
	\verb\|?phs_only\|. If you set this \ttt{true}, \whizard\ skips the actual
	integration after the phase-space file has been generated. There is also a
	parameter \verb\|?vis_channels\| which can be set independently; if this is
	\ttt{true}, \whizard\ will generate a graphical visualization of the
	phase-space parameterizations encoded in the phase-space file. This
	file has to be taken with a grain of salt because phase space channels
	are represented by sample Feynman diagrams for the corresponding
	channel. This does however {\em not} mean that in the matrix element
	other Feynman diagrams are missing (the default matrix element method,
	\oMega, is not using Feynman-diagrammatic amplitudes at all).

	Things might go wrong with the default phase-space generation, or manual
	intervention might be necessary to improve later performance. There are a few
	parameters that control the algorithm of phase-space generation. To
	understand their meaning, you should realize that phase-space
	parameterizations are modeled after (dominant) Feynman graphs for the current
	process.

	\subsubsection{The main phase space setup {\em wood}}

	For the main phase-space parameterization of \whizard, which is called
	\ttt{"wood"}, there are many different parameters and flags that allow
	to tune and customize the phase-space setup for every certain process:

	The parameter \verb\|phs_off_shell\| controls the number of off-shell lines in
	those graphs, not counting $s$-channel resonances and logarithmically enhanced
	$s$- and $t$-channel lines. The default value is $2$. Setting it to zero
	will drop everything that is not resonant or logarithmically enhanced.
	Increasing it will include more subdominant graphs. (\whizard\ increases the
	value automatically if the default value does not work.)

	There is a similar parameter \verb\|phs_t_channel\| which controls
	multiperipheral graphs in the parameterizations. The default value is $6$, so
	graphs with up to $6$ $t/u$-channel lines are considered. In particular
	cases, such as $e^+e^-\to n\gamma$, all graphs are multiperipheral, and for
	$n>7$ \whizard\ would find no parameterizations in the default setup.
	Increasing the value of \verb\|phs_t_channel\| solves this problem. (This is
	presently not done automatically.)

	There are two numerical parameters that describe whether particles are treated
	like massless particles in particular situations. The value of
	\verb\|phs_threshold_s\| has the default value $50\;\GeV$. Hence, $W$ and $Z$
	are considered massive, while $b$ quarks are considered massless. This
	categorization is used for deciding whether radiation of $b$ quarks can lead
	to (nearly) singular behavior, i.e., logarithmic enhancement, in the infrared
	and collinear regions. If yes, logarithmic mappings are applied to phase
	space. Analogously, \verb\|phs_threshold_t\| decides about potential
	$t$-channel singularities. Here, the default value is $100\;\GeV$, so
	amplitudes with $W$ and $Z$ in the $t$-channel are considered as
	logarithmically enhanced. For a high-energy hadron collider of 40 or
	100 TeV energy, also $W$ and $Z$ in $s$-channel like situations might
	be necessary to be considered massless.

	Such logarithmic mappings need a dimensionful scale as parameter. There are
	three such scales, all with default value $10\;\GeV$: \verb\|phs_e_scale\|
	(energy), \verb\|phs_m_scale\| (invariant mass), and \verb\|phs_q_scale\|
	(momentum transfer). If cuts and/or masses are such that energies, invariant
	masses of particle pairs, and momentum transfer values below $10\;\GeV$ are
	excluded or suppressed, the values can be kept. In special cases they should
	be changed: for instance, if you want to describe $\gamma^*\to\mu^+\mu^-$
	splitting well down to the muon mass, no cuts, you may set
	\verb\|phs_m_scale = mmu\|. The convergence of the Monte-Carlo integration
	result will be considerably faster.

	There are more flags. These and more details about the phase space
	parameterization will be described in Sec.~\ref{sec:wood}.


	\subsection{Cuts}

	\whizard~2 does not apply default cuts to the integrand. Therefore, processes
	with massless particles in the initial, intermediate, or final states may not
	have a finite cross section. This fact will manifest itself in an integration
	that does not converge, or is unstable, or does not yield a reasonable error
	or reweighting efficiency even for very large numbers of iterations or calls
	per iterations. When doing any calculation, you should verify first that the
	result that you are going to compute is finite on physical grounds. If not,
	you have to apply cuts that make it finite.

	A set of cuts is defined by the \ttt{cuts} statement. Here is an example
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	cuts = all Pt > 20 GeV [colored]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This implies that events are kept only (for integration and simulation) if the
	transverse momenta of all colored particles are above $20\;\GeV$.

	Technically, \ttt{cuts} is a special object, which is unique within a given
	scope, and is defined by the logical expression on the right-hand side of the
	assignment. It may be defined in global scope, so it is applied to all
	subsequent processes. It may be redefined by another \ttt{cuts} statement.
	This overrides the first cuts setting: the \ttt{cuts} statement is not
	cumulative. Multiple cuts should be specified by the logical operators of
	\sindarin, for instance
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	cuts = all Pt > 20 GeV [colored]
	and all E > 5 GeV [photon]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Cuts may also be defined local to an \ttt{integrate} command, i.e., in the
	options in braces. They will apply only to the processes being integrated,
	overriding any global cuts.

	The right-hand side expression in the \ttt{cuts} statement is evaluated at the
	point where it is used by an \ttt{integrate} command (which could be an
	implicit one called by \ttt{simulate}). Hence, if the logical expression
	contains parameters, such as
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	mH = 120 GeV
	cuts = all M > mH [b, bbar]
	mH = 150 GeV
	integrate (myproc)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	the Higgs mass value that is inserted is the value in place when
	\ttt{integrate} is evaluated, $150\;\GeV$ in this example. This same value
	will also be used when the process is called by a subsequent \ttt{simulate};
	it is \ttt{integrate} which compiles the cut expression and stores it among
	the process data. This behavior allows for scanning over parameters without
	redefining the cuts every time.

	The cut expression can make use of all variables and constructs that are
	defined at the point where it is evaluated. In particular, it can make use of
	the particle content and kinematics of the hard process, as in the example
	above. In addition to the predefined variables and those defined by the user,
	there are the following variables which depend on the hard process:
	\begin{quote}
	\begin{tabular}{ll}
	integer: & \ttt{n\_in}, \ttt{n\_out}, \ttt{n\_tot} \\
	real: & \ttt{sqrts}, \ttt{sqrts\_hat}
	\end{tabular}
	\end{quote}
	Example:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	cuts = sqrts_hat > 150 GeV
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	The constants \ttt{n\_in} etc.\ are sometimes useful if a generic set of cuts
	is defined, which applies to various processes simultaneously.

	The user is encouraged to define his/her own set of cuts, if possible in a
	process-independent manner, even if it is not required. The \ttt{include}
	command allows for storing a set of cuts in a separate \sindarin\ script which
	may be read in anywhere. As an example, the system directories contain a file
	\verb\|default_cuts.sin\| which may be invoked by
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	include ("default_cuts.sin")
	\end{verbatim}
	\end{footnotesize}
	\end{quote}


	\subsection{QCD scale and coupling}

	\whizard\ treats all physical parameters of a model, the coefficients in the
	Lagrangian, as constants. As a leading-order program, \whizard\ does not make
	use of running parameters as they are described by renormalization theory.
	For electroweak interactions where the perturbative expansion is sufficiently
	well behaved, this is a consistent approach.

	As far as QCD is concerned, this approach does not yield numerically
	reliable results, even on the validity scale of the tree approximation.
	In \whizard\ttt{2}, it is therefore possible to replace the fixed value of
	$\alpha_s$ (which is accessible as the intrinsic model variable
	\verb\|alphas\|), by a function of an energy scale $\mu$.

	This is controlled by the parameter \verb\|?alphas_is_fixed\|, which is
	\ttt{true} by default. Setting it to \ttt{false} enables running~$\alpha_s$.
	The user has then to decide how $\alpha_s$ is calculated.

	One option is to set \verb\|?alphas_from_lhapdf\| (default \ttt{false}). This
	is recommended if the \lhapdf\ library is used for including structure
	functions, but it may also be set if \lhapdf\ is not invoked. \whizard\ will
	then use the $\alpha_s$ formula and value that matches the active
	\lhapdf\ structure function set and member.

	In the very same way, the $\alpha_s$ running from the PDFs implemented
	intrinsically in \whizard\ can be taken by setting
	\verb\|?alphas_from_pdf_builtin\| to \ttt{true}. This is the same
	running then the one from \lhapdf, if the intrinsic PDF coincides with
	a PDF chosen from \lhapdf.

	If this is not appropriate, there are again two possibilities. If
	\verb\|?alphas_from_mz\| is \ttt{true}, the user input value \verb\|alphas\| is
	interpreted as the running value $\alpha_s(m_Z)$, and for the particular
	event, the coupling is evolved to the appropriate scale $\mu$. The formula is
	controlled by the further parameters \verb\|alphas_order\| (default $0$,
	meaning leading-log; maximum $2$) and \verb\|alphas_nf\| (default $5$).

	Otherwise there is the option to set \verb\|?alphas_from_lambda_qcd = true\|
	in order to evaluate $\alpha_s$ from the scale $\Lambda_{\rm QCD}$,
	represented by the intrinsic variable \verb\|lambda_qcd\|. The reference
	value for the QCD scale is $\Lambda\_{\rm QCD} = 200$
	MeV. \verb\|alphas_order\| and \verb\|alphas_nf\| apply analogously.

	Note that for using one of the running options for $\alpha_s$, always
	\ttt{?alphas\_is\_fixed = false} has to be invoked.

	In any case, if $\alpha_s$ is not fixed, each event has to be assigned an
	energy scale. By default, this is $\sqrt{\hat s}$, the partonic invariant
	mass of the event. This can be replaced by a user-defined scale, the special
	object \ttt{scale}. This is assigned and used just like the \ttt{cuts}
	object. The right-hand side is a real-valued expression. Here is an example:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	scale = eval Pt [sort by -Pt [colored]]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	This selects the $p_T$ value of the first entry in the list of colored
	particles sorted by decreasing $p_T$, i.e., the $p_T$ of the hardest jet.

	The \ttt{scale} definition is used not just for running $\alpha_s$ (if
	enabled), but it is also the factorization scale for the \lhapdf\ structure
	functions.

	These two values can be set differently by specifying
	\ttt{factorization\_scale} for the scale at which the PDFs are
	evaluated. Analogously, there is a variable
	\ttt{renormalization\_scale} that sets the scale value for the running
	$\alpha_s$. Whenever any of these two values is set, it supersedes the
	\ttt{scale} value.

	Just like the \ttt{cuts} expression, the expressions for \ttt{scale},
	\ttt{factorization\_scale} and also \ttt{renormalization\_scale}
	are evaluated at the point where it is read by an explicit or implicit
	\ttt{integrate} command.


	\subsection{Reweighting factor}

	It is possible to reweight the integrand by a user-defined function of the
	event kinematics. This is done by specifying a \ttt{weight} expression.
	Syntax and usage is exactly analogous to the \ttt{scale} expression. Example:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	weight = eval (1 + cos (Theta) ^ 2) [lepton]
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	We should note that the phase-space setup is not aware of this reweighting, so
	in complicated cases you should not expect adaptation to achieve as accurate
	results as for plain cross sections.

	Needless to say, the default \ttt{weight} is unity.


	\section{Events}

	After the cross section integral of a scattering process is known (or the
	partial-width integral of a decay process), \whizard\ can generate event
	samples. There are two limiting cases or modes of event generation:
	\begin{enumerate}
	\item
	For a physics simulation, one needs \emph{unweighted} events, so the
	probability of a process and a kinematical configuration in the event sample
	is given by its squared matrix element.
	\item
	Monte-Carlo integration yields \emph{weighted} events, where the probability
	(without any grid adaptation) is uniformly distributed over phase space,
	while the weight of the event is given by its squared matrix element.
	\end{enumerate}
	The choice of parameterizations and the iterative adaptation of the
	integration grids gradually shift the generation mode from option 2 to option
	1, which obviously is preferred since it simulates the actual outcome of an
	experiment. Unfortunately, this adaptation is perfect only in trivial cases,
	such that the Monte-Carlo integration yields non-uniform probability still
	with weighted events. Unweighted events are obtained by rejection, i.e.,
	accepting an event with a probability equal to its own weight divided by the
	maximal possible weight. Furthermore, the maximal weight is never precisely
	known, so this probability can only be estimated.

	The default generation mode of \whizard\ is unweighted. This is controlled by
	the parameter \verb\|?unweighted\| with default value \ttt{true}. Unweighted
	events are easy to interpret and can be directly compared with experiment, if
	properly interfaced with detector simulation and analysis.

	However, when applying rejection to generate unweighted events, the generator
	discards information, and for a single event it needs, on the average,
	$1/\epsilon$ calls, where the efficiency $\epsilon$ is the ratio of the
	average weight over the maximal weight. If \verb\|?unweighted\| is \ttt{false},
	all events are kept and assigned their respective weights in histograms or
	event files.


	\subsection{Simulation}
	\label{sec:simulation}

	The \ttt{simulate} command generates an event sample. The number of events
	can be set either by specifying the integer variable \verb\|n_events\|, or by
	the real variable \verb\|luminosity\|. (This holds for unweighted events. If
	weighted events are requested, the luminosity value is ignored.) The
	luminosity is measured in
	femtobarns, but other units can be used, too. Since the cross sections for the
	processes are known at that point, the number of events is determined as the
	luminosity multiplied by the cross section.

	As usual, both parameters can be set either as global or as local parameters:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	n_events = 10000
	simulate (proc1)
	simulate (proc2, proc3) { luminosity = 100 / 1 pbarn }
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	In the second example, both \verb\|n_events\| and \verb\|luminosity\| are set.
	In that case, \whizard\ chooses whatever produces the larger number of events.

	If more than one process is specified in the argument of \ttt{simulate},
	events are distributed among the processes with fractions proportional to
	their cross section values. The processes are mixed randomly, as it would be
	the case for real data.

	The raw event sample is written to a file which is named after the first process
	in the argument of \ttt{simulate}. If the process name is \ttt{proc1}, the
	file will be named \ttt{proc1.evx}. You can choose another basename by the
	string variable \verb\|$sample\|. For instance,
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	simulate (proc1) { n_events = 4000 $sample = "my_events" }
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	will produce an event file \verb\|my_events.evx\| which contains $4000$ events.

	This event file is in a machine-dependent binary format, so it is not of
	immediate use. Its principal purpose is to serve as a cache: if you re-run
	the same script, before starting simulation, it will look for an existing
	event file that matches the input. If nothing has changed, it will find the
	file previously generated and read in the events, instead of generating them.
	Thus you can modify the analysis or any further steps without repeating the
	time-consuming task of generating a large event sample. If you change the
	number of events to generate, the program will make use of the existing event
	sample and generate further events only when it is used up. If necessary, you
	can suppress the writing/reading of the raw event file by the parameters
	\verb\|?write_raw\| and \verb\|?read_raw\|.

	If you try to reuse an event file that has been written by a previous version
	of \whizard, you may run into an incompatibility, which will be detected as an
	error. If this happens, you may enforce a compatibility mode (also for
	writing) by setting \ttt{\$event\_file\_version} to the appropriate version
	string, e.g., \verb\|"2.0"\|. Be aware that this may break some more recent
	features in the event analysis.

	Generating an event sample can serve several purposes. First of all,
	it can be analyzed directly, by \whizard's built-in capabilities, to
	produce tables, histograms, or calculate inclusive observables. The
	basic analysis features of \whizard\ are described below in
	Sec.~\ref{sec:analysis}. It can be written to an external file in a
	standard format that a human or an external program can understand.
	In Chap.~\ref{chap:events}, you will find a more thorough discussion
	of event generation with \whizard, which also covers in detail the
	available event-file formats. Finally, \whizard\ can rescan an
	existing event sample. The event sample may either be the result of a
	previous \ttt{simulate} run or, under certain conditions, an external
	event sample produced by another generator or reconstructed from
	data.
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	rescan "my_events" (proc1) { $pdf_builtin_set = "MSTW2008LO" }
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	The rescanning may apply different parameters and recalculate the
	matrix element, it may apply a different event selection, it may
	reweight the events by a different PDF set (as above). The modified
	event sample can again be analyzed or written to file. For more
	details, cf.\ Sec.~\ref{sec:rescan}.

	%%%%%%%%%%%%%%%

	\subsection{Decays}
	\label{sec:decays}

	Normally, the events generated by the \ttt{simulate} command will be identical
	in structure to the events that the \ttt{integrate} command generates. This
	implies that for a process such as $pp\to W^+W^-$, the final-state particles
	are on-shell and stable, so they appear explicitly in the generated event
	files. If events are desired where the decay products of the $W$ bosons
	appear, one has to generate another process, e.g., $pp\to u\bar d\bar ud$. In
	this case, the intermediate vector bosons, if reconstructed, are off-shell as
	dictated by physics, and the process contains all intermediate states that are
	possible. In this example, the matrix element contains also $ZZ$, photon, and
	non-resonant intermediate states. (This can be restricted via the
	\verb\|$restrictions\| option, cf.\ \ref{sec:process options}.

	Another approach is to factorize the process in production (of $W$ bosons) and
	decays ($W\to q\bar q$). This is actually the traditional approach, since it
	is much less computing-intensive. The factorization neglects all off-shell
	effects and irreducible background diagrams that do not have the decaying
	particles as an intermediate resonance. While \whizard\ is able to deal with
	multi-particle processes without factorization, the needed computing resources
	rapidly increase with the number of external particles. Particularly,
	it is the phase space integration that becomes the true bottleneck for
	a high multiplicity of final state particles.

	In order to use the factorized approach, one has to specify particles
	as \ttt{unstable}. (Also, the \ttt{?allow\_decays} switch must be \ttt{true};
	this is however its default value.) We give an example for a $pp \to Wj$ final
	state:
	\begin{code}
	process wj = u, gl => d, Wp
	process wen = Wp => E1, n1

	integrate (wen)

	sqrts = 7 TeV
	beams = p, p => pdf_builtin
	unstable Wp (wen)
	simulate (wj) { n_events = 1 }
	\end{code}
	This defines a $2 \to 2$ hard scattering process of $W + j$ production
	at the 7 TeV LHC 2011 run. The $W^+$ is marked as unstable, with its
	decay process being $W^+ \to e^+ \nu_e$. In the \ttt{simulate} command
	both processes, the production process \ttt{wj} and the decay process
	\ttt{wen} will be integrated, while the $W$ decays become effective
	only in the final event sample. This event sample will contain final
	states with multiplicity $3$, namely $e^+ \nu_e d$. Note that here
	only one decay process is given, hence the branching ratio for the
	decay will be taken to be $100 \%$ by \whizard.

	A natural restriction of the factorized approach is the implied narrow-width
	approximation. Theoretically, this restriction is necessary since whenever
	the width plays an important role, the usage of the factorized approach will
	not be fully justified. In particular, all involved matrix elements must be
	evaluated on-shell, or otherwise gauge-invariance issues could spoil the
	calculation. (There are plans for a future \whizard\ version
	to also include Breit-Wigner or Gaussian distributions when using the
	factorized approach.)

	Decays can be concatenated, e.g. for top pair production and
	decay, $e^+ e^- \to t \bar t$ with decay $t \to W^+ b$, and subsequent
	leptonic decay of the $W$ as in $W^+ \to \mu^+ \nu_\mu$:
	\begin{code}
	process eett = e1, E1 => t, tbar
	process t_dec = t => Wp, b
	process W_dec = Wp => E2, n2

	unstable t (t_dec)
	unstable Wp (W_dec)

	sqrts = 500
	simulate (eett) { n_events = 1 }
	\end{code}
	Note that in this case the final state in the event file will consist
	of $\bar t b \mu^+ \nu_\mu$ because the anti-top is not decayed.

	If more than one decay process is being specified like in
	\begin{code}
	process eeww = e1, E1 => Wp, Wm
	process w_dec1 = Wp => E2, n2
	process w_dec2 = Wp => E3, n3

	unstable Wp (w_dec1, w_dec2)

	sqrts = 500
	simulate (eeww) { n_events = 100 }
	\end{code}
	then \whizard\ takes the integrals of the specified decay processes
	and distributes the decays statistically according to the calculated
	branching ratio. Note that this might not be the true branching ratios
	if decay processes are missing, or loop corrections to partial widths
	give large(r) deviations. In the calculation of the code above,
	\whizard\ will issue an output like
	\begin{code}
	\| Unstable particle W+: computed branching ratios:
	\| w_dec1: 5.0018253E-01 mu+, numu
	\| w_dec2: 4.9981747E-01 tau+, nutau
	\| Total width = 4.5496085E-01 GeV (computed)
	\| = 2.0490000E+00 GeV (preset)
	\| Decay options: helicity treated exactly
	\end{code}
	So in this case, \whizard\ uses 50 \% muonic and 50 \% tauonic decays
	of the positively charged $W$, while the $W^-$ appears directly in the
	event file. \whizard\ shows the difference between the preset $W$
	width from the physics model file and the value computed from the two
	decay channels.

	Note that a particle in a \sindarin\ input script can be also explictly
	marked as being stable, using the
	\begin{code}
	stable <particle-tag>
	\end{code}
	constructor for the particle \ttt{<particle-tag>}.


	\subsubsection{Resetting branching fractions}
	\label{sec:br-reset}

	As described above, decay processes that appear in a simulation must
	first be integrated by the program, either explicitly via the
	\verb\|integrate\| command, or implicitly by \verb\|unstable\|. In either
	case, \whizard\ will use the computed partial widths in order to
	determine branching fractions. In the spirit of a purely leading-order
	calculation, this is consistent.

	However, it may be desired to rather use different branching-fraction
	values for the decays of a particle, for instance, NLO-corrected
	values. In fact, after \whizard\ has integrated any process, the
	integration result becomes available as an ordinary
	\sindarin\ variable. For instance, if a decay process has the ID
	\verb\|h_bb\|, the integral of this process -- the partial width, in
	this case -- becomes the variable \verb\|integral(h_bb)\|. This
	variable may be reset just like any other variable:
	\begin{code}
	integral(h_bb) = 2.40e-3 GeV
	\end{code}
	The new value will be used for all subsequent Higgs branching-ratio
	calculations and decays, if an unstable Higgs appears in a process for
	simulation.


	\subsubsection{Spin correlations in decays}
	\label{sec:spin-correlations}

	By default, \whizard\ applies full spin and color correlations to the
	factorized processes, so it keeps both color and spin coherence between
	productions and decays. Correlations between decay products of distinct
	unstable particles in the same event are also fully retained. The program
	sums over all intermediate quantum numbers.

	Although this approach obviously yields the optimal description with the
	limits of production-decay factorization, there is support for a simplified
	handling of particle decays. Essentially, there are four options, taking a
	decay \ttt{W\_ud}: $W^-\to \bar u d$ as an example:
	\begin{enumerate}
	\item
	Full spin correlations: \verb\|unstable Wp (W_ud)\|
	\item
	Isotropic decay: \verb\|unstable Wp (W_ud) { ?isotropic_decay = true }\|
	\item
	Diagonal decay matrix:
	\verb\|unstable Wp (W_ud) { ?diagonal_decay = true }\|
	\item
	Project onto specific helicity:
	\verb\|unstable Wp (W_ud) { decay_helicity = -1 }\|
	\end{enumerate}
	Here, the isotropic option completely eliminates spin correlations. The
	diagonal-decays option eliminates just the off-diagonal entries of the $W$
	spin-density matrix. This is equivalent to a measurement of spin before the
	decay. As a result, spin correlations are still present in the classical
	sense, while quantum coherence is lost. The definite-helicity option is
	similar and additional selects only the specified helicity component for the
	decaying particle, so its decay distribution assumes the shape for an
	accordingly polarized particle. All options apply in the rest frame of the
	decaying particle, with the particle's momentum as the quantization axis.

	\subsubsection{Automatic decays}

	A convenient option is if the user did not have to specify the decay
	mode by hand, but if they were generated automatically. \whizard\ does
	have this option: the flag \ttt{?auto\_decays} can be set to
	\ttt{true}, and is taking care of that. In that case the list for the
	decay processes of the particle marked as unstable is left empty (we
	take a $W^-$ again as example):
	\begin{code}
	unstable Wm () { ?auto_decays = true }
	\end{code}
	\whizard\ then inspects at the local position within the \sindarin\
	input file where that \ttt{unstable} statement appears the masses of
	all the particles of the active physics model in order to determine
	which decays are possible. It then calculates their partial widths.
	There are a few options to customize the decays. The integer variable
	\ttt{auto\_decays\_multiplicity} allows to set the maximal
	multiplicity of the final states considered in the auto decay
	option. The defaul value of that variable is \ttt{2}; please be quite
	careful when setting this to values larger than that. If you do so,
	the flag \ttt{?auto\_decays\_radiative} allows to specify whether
	final states simply containing additional resolved gluons or photons
	are taken into account or not. For the example above, you almost hit
	the PDG value for the $W$ total width:
	\begin{code}
	\| Unstable particle W-: computed branching ratios:
	\| decay_a24_1: 3.3337068E-01 d, ubar
	\| decay_a24_2: 3.3325864E-01 s, cbar
	\| decay_a24_3: 1.1112356E-01 e-, nuebar
	\| decay_a24_4: 1.1112356E-01 mu-, numubar
	\| decay_a24_5: 1.1112356E-01 tau-, nutaubar
	\| Total width = 2.0478471E+00 GeV (computed)
	\| = 2.0490000E+00 GeV (preset)
	\| Decay options: helicity treated exactly
	\end{code}

	\subsubsection{Future shorter notation for decays}

	{\color{red} In an upcoming \whizard\ version there will be a shorter and more
	concise notation already in the process definition for such decays,
	which, however, is current not yet implemented. The two first examples
	above will then be shorter and have this form:}
	\begin{code}
	process wj = u, gl => (Wp => E1, n1), d
	\end{code}
	{\color{red} as well as }
	\begin{code}
	process eett = e1, E1 => (t => (Wp => E2, n2), b), tbar
	\end{code}

	%%%%%

	\subsection{Event formats}

	As mentioned above, the internal \whizard\ event format is a
	machine-dependent event format. There are a series of human-readable
	ASCII event formats that are supported: very verbose formats intended
	for debugging, formats that have been agreed upon during the Les
	Houches workshops like LHA and LHEF, or formats that are steered
	through external packages like HepMC. More details about event formats
	can be found in Sec.~\ref{sec:eventformats}.

	%%%%%%%%%%%%%%%

	\section{Analysis and Visualization}
	\label{sec:analysis}

	\sindarin\ natively supports basic methods of data analysis and visualization
	which are frequently used in high-energy physics studies. Data generated
	during script execution, in particular simulated event samples, can be
	analyzed to evaluate further observables, fill histograms, and draw
	two-dimensional plots.

	So the user does not have to rely on his/her own external graphical
	analysis method (like e.g. \ttt{gnuplot} or \ttt{ROOT} etc.), but can
	use methods that automatically ship with \whizard. In many cases, the
	user, however, clearly will use his/her own analysis machinery,
	especially experimental collaborations.

	In the following sections, we first summarize the available data structures,
	before we consider their graphical display.



	\subsection{Observables}

	Analyses in high-energy physics often involve averages of quantities other
	than a total cross section. \sindarin\ supports this by its \ttt{observable}
	objects. An \ttt{observable} is a container that collects a single
	real-valued variable with a statistical distribution. It is declared by a
	command of the form
	\begin{quote}
	\begin{footnotesize}
	\ttt{observable \emph{analysis-tag}}
	\end{footnotesize}
	\end{quote}
	where \ttt{\emph{analysis-tag}} is an identifier that follows the same rules
	as a variable name.

	Once the observable has been declared, it can be filled with values. This is
	done via the \ttt{record} command:
	\begin{quote}
	\begin{footnotesize}
	\ttt{record \emph{analysis-tag} (\emph{value})}
	\end{footnotesize}
	\end{quote}
	To make use of this, after values have been filled, we want to perform the
	actual analysis and display the results. For an observable, these are the
	mean value and the standard deviation. There is the command
	\ttt{write\_analysis}:
	\begin{quote}
	\begin{footnotesize}
	\ttt{write\_analysis (\emph{analysis-tag})}
	\end{footnotesize}
	\end{quote}

	Here is an example:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	observable obs
	record obs (1.2) record obs (1.3) record obs (2.1) record obs (1.4)
	write_analysis (obs)
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	The result is displayed on screen:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	###############################################################################
	# Observable: obs
	average = 1.500000000000E+00
	error[abs] = 2.041241452319E-01
	error[rel] = 1.360827634880E-01
	n_entries = 4
	\end{verbatim}
	\end{footnotesize}
	\end{quote}


	\subsection{The analysis expression}
	\label{subsec:analysis}

	The most common application is the computation of event observables -- for
	instance, a forward-backward asymmetry -- during simulation. To this end,
	there is an \ttt{analysis} expression, which behaves very similar to the
	\ttt{cuts} expression. It is defined either globally
	\begin{quote}
	\begin{footnotesize}
	\ttt{analysis = \emph{logical-expr}}
	\end{footnotesize}
	\end{quote}
	or as a local option to the \ttt{simulate} or \ttt{rescan} commands which
	generate and handle event samples. If this expression is defined, it is not
	evaluated immediately, but it is evaluated once for each event in the sample.

	In contrast to the \ttt{cuts} expression, the logical value of the
	\ttt{analysis} expression is discarded; the expression form has been chosen
	just by analogy. To make this useful, there is a variant of the \ttt{record}
	command, namely a \ttt{record} function with exactly the same syntax. As an
	example, here is a calculation of the forward-backward symmetry in a process
	\ttt{ee\_mumu} with final state $\mu^+\mu^-$:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	observable a_fb
	analysis = record a_fb (eval sgn (Pz) ["mu-"])
	simulate (ee_mumu) { luminosity = 1 / 1 fbarn }
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	The logical return value of \ttt{record} -- which is discarded here -- is
	\ttt{true} if the recording was successful. In case of histograms (see below)
	it is true if the value falls within bounds, false otherwise.

	Note that the function version of \ttt{record} can be used anywhere in
	expressions, not just in the \ttt{analysis} expression.

	When \ttt{record} is called for an observable or histogram in simulation mode,
	the recorded value is weighted appropriately. If \ttt{?unweighted} is true,
	the weight is unity, otherwise it is the event weight.

	The \ttt{analysis} expression can involve any other construct
	that can be expressed as an expression in \sindarin. For instance, this
	records the energy of the 4th hardest jet in a histogram \ttt{pt\_dist}, if it
	is in the central region:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	analysis =
	record pt_dist (eval E [extract index 4
	[sort by - Pt
	[select if -2.5 < Eta < 2.5 [colored]]]])
	\end{verbatim}
	\end{footnotesize}
	\end{quote}
	Here, if there is no 4th jet in the event which satisfies the criterion, the
	result will be an undefined value which is not recorded. In that case,
	\ttt{record} evaluates to \ttt{false}.

	Selection cuts can be part of the analysis expression:
	\begin{code}
	analysis =
	if any Pt > 50 GeV [lepton] then
	record jet_energy (eval E [collect [jet]])
	endif
	\end{code}
	Alternatively, we can specify a separate selection expression:
	\begin{code}
	selection = any Pt > 50 GeV [lepton]
	analysis = record jet_energy (eval E [collect [jet]])
	\end{code}
	The former version writes all events to file (if requested), but
	applies the analysis expression only to the selected events. This
	allows for the simultaneous application of different selections to a
	single event sample. The latter version applies the selection to all
	events before they are analyzed or written to file.

	The analysis expression can make use of all variables and constructs that are
	defined at the point where it is evaluated. In particular, it can make use of
	the particle content and kinematics of the hard process, as in the example
	above. In addition to the predefined variables and those defined by the user,
	there are the following variables which depend on the hard process. Some of
	them are constants, some vary event by event:
	\begin{quote}
	\begin{tabular}{ll}
	integer: &\ttt{event\_index} \\
	integer: &\ttt{process\_num\_id} \\
	string: &\ttt{\$process\_id} \\
	integer: &\ttt{n\_in}, \ttt{n\_out}, \ttt{n\_tot} \\
	real: &\ttt{sqrts}, \ttt{sqrts\_hat} \\
	real: &\ttt{sqme}, \ttt{sqme\_ref} \\
	real: &\ttt{event\_weight}, \ttt{event\_excess}
	\end{tabular}
	\end{quote}
	The \ttt{process\_num\_id} is the numeric ID as used by external
	programs, while the process index refers to the current library. By
	default, the two are identical. The process index itself is not
	available as a predefined observable. The \ttt{sqme} and
	\ttt{sqme\_ref} values indicate the squared matrix element and the
	reference squared matrix element, respectively. The latter applies
	when comparing with a reference sample (the \ttt{rescan} command).

	\ttt{record} evaluates to a logical, so several \ttt{record} functions may
	be concatenated by the logical operators \ttt{and} or \ttt{or}. However,
	since usually the further evaluation should not depend on the return value of
	\ttt{record}, it is more advisable to concatenate them by the semicolon
	(\ttt{;}) operator. This is an operator (\emph{not} a statement separator or
	terminator) that connects two logical expressions and evaluates both of them
	in order. The lhs result is discarded, the result is the value of the rhs:
	\begin{quote}
	\begin{footnotesize}
	\begin{verbatim}
	analysis =
	record hist_pt (eval Pt [lepton]) ; record hist_ct (eval cos (Theta) [lepton])
	\end{verbatim}
	\end{footnotesize}
	\end{quote}


	\subsection{Histograms}
	\label{sec:histogram}

	In \sindarin, a histogram is declared by the command
	\begin{quote}
	\begin{footnotesize}
	\ttt{histogram \emph{analysis-tag} (\emph{lower-bound}, \emph{upper-bound})}
	\end{footnotesize}
	\end{quote}
	This creates a histogram data structure for an (unspecified) observable. The
	entries are organized in bins between the real values \ttt{\emph{lower-bound}}
	and \ttt{\emph{upper-bound}}. The number of bins is given by the value of the
	intrinsic integer variable \ttt{n\_bins}, the default value is 20.

	The \ttt{histogram} declaration supports an optional argument, so the number
	of bins can be set locally, for instance
	\begin{quote}
	\begin{footnotesize}
	\ttt{histogram pt\_distribution (0 GeV, 500 GeV) \{ n\_bins = 50 \}}
	\end{footnotesize}
	\end{quote}
	Sometimes it is more convenient to set the bin width directly. This can be
	done in a third argument to the \ttt{histogram} command.
	\begin{quote}
	\begin{footnotesize}
	\ttt{histogram pt\_distribution (0 GeV, 500 GeV, 10 GeV)}
	\end{footnotesize}
	\end{quote}
	If the bin width is specified this way, it overrides the setting of
	\ttt{n\_bins}.

	The \ttt{record} command or function fills histograms. A single call
	\begin{quote}
	\begin{footnotesize}
	\ttt{record (\emph{real-expr})}
	\end{footnotesize}
	\end{quote}
	puts the value of \ttt{\emph{real-expr}} into the appropriate bin. If
	the call is issued during a simulation where \ttt{unweighted} is false, the
	entry is weighted appropriately.

	If the value is outside the range specified in the histogram declaration, it
	is put into one of the special underflow and overflow bins.

	The \ttt{write\_analysis} command prints the histogram contents as a table in
	blank-separated fixed columns. The columns are: $x$ (bin midpoint), $y$ (bin
	contents), $\Delta y$ (error), excess weight, and $n$ (number of entries).
	The output also contains comments initiated by a \verb\|#\| sign, and following
	the histogram proper, information about underflow and overflow as well as
	overall contents is added.


	\subsection{Plots}
	\label{sec:plot}

	While a histogram stores only summary information about a data set, a
	\ttt{plot} stores all data as $(x,y)$ pairs, optionally with errors. A plot
	declaration is as simple as
	\begin{quote}
	\begin{footnotesize}
	\ttt{plot \emph{analysis-tag}}
	\end{footnotesize}
	\end{quote}
	Like observables and histograms, plots are filled by the \ttt{record} command
	or expression. To this end, it can take two arguments,
	\begin{quote}
	\begin{footnotesize}
	\ttt{record (\emph{x-expr}, \emph{y-expr})}
	\end{footnotesize}
	\end{quote}
	or up to four:
	\begin{quote}
	\begin{footnotesize}
	\ttt{record (\emph{x-expr}, \emph{y-expr}, \emph{y-error})}
	\\
	\ttt{record (\emph{x-expr}, \emph{y-expr},
	\emph{y-error-expr}, \emph{x-error-expr})}
	\end{footnotesize}
	\end{quote}
	Note that the $y$ error comes first. This is because applications will
	demand errors for the $y$ value much more often than $x$ errors.

	The plot output, again written by \ttt{write\_analysis} contains the four
	values for each point, again in the ordering $x,y,\Delta y, \Delta x$.


	\subsection{Analysis Output}

	There is a default format for piping information into observables,
	histograms, and plots. In older versions of \whizard\ there was a
	first version of a custom format, which was however rather limited.
	A more versatile custom output format will be coming soon.

	\begin{enumerate}
	\item
	By default, the \ttt{write\_analysis} command prints all data to the
	standard output. The data are also written to a default file with the
	name \ttt{whizard\_analysis.dat}.
	Output is redirected to a file with a different name if the
	variable \ttt{\$out\_file} has a nonempty value. If the file is
	already open, the output will be appended to
	the file, and it will be kept open. If the file is not open,
	\ttt{write\_analysis} will open the output file by itself, overwriting any
	previous file with the same name, and close it again after data have been
	written.

	The command is able to print more than one dataset, following the syntax
	\begin{quote}
	\begin{footnotesize}
	\ttt{write\_analysis (\emph{analysis-tag1}, \emph{analysis-tag2}, \ldots)
	\{ \emph{options} \}}
	\end{footnotesize}
	\end{quote}
	The argument in brackets may also be empty or absent; in this case, all
	currently existing datasets are printed.

	The default data format is suitable for compiling analysis data by \whizard's
	built-in \gamelan\ graphics driver (see below and particularly
	Chap.~\ref{chap:visualization}). Data are written in
	blank-separated fixed columns, headlines and comments are initiated by the
	\verb\|#\| sign, and each data set is terminated by a blank line. However,
	external programs often require special formatting.

	The internal graphics driver \gamelan\ of \whizard\ is initiated by
	the \ttt{compile\_analysis} command. Its syntax is the same, and it
	contains the \ttt{write\_analysis} if that has not been separately
	called (which is unnecessary). For more details about the \gamelan\
	graphics driver and data visualization within \whizard, confer
	Chap.~\ref{chap:visualization}.

	\item
	Custom format. Not yet (re-)implemented in a general form.
	\end{enumerate}


	\section{Custom Input/Output}
	\label{sec:I/O}

	\whizard\ is rather chatty. When you run examples or your own scripts, you
	will observe that the program echoes most operations (assignments, commands,
	etc.) on the standard output channel, i.e., on screen. Furthermore, all
	screen output is copied to a log file which by default is named
	\ttt{whizard.log}.

	For each integration run, \whizard\ writes additional process-specific
	information to a file \ttt{\var{tag}.log}, where \ttt{\var{tag}} is the
	process name. Furthermore, the \ttt{write\_analysis} command dumps analysis
	data -- tables for histograms and plots -- to its own set of files, cf.\
	Sec.~\ref{sec:analysis}.

	However, there is the occasional need to write data to extra files in a custom
	format. \sindarin\ deals with that in terms of the following commands:

	\subsection{Output Files}

	\subsubsection{open\_out}
	\begin{syntax}
	open\_out (\var{filename}) \\
	open\_out (\var{filename}) \{ \var{options} \}
	\end{syntax}
	Open an external file for writing. If the file exists, it is overwritten
	without warning, otherwise it is created. Example:
	\begin{code}
	open_out ("my_output.dat")
	\end{code}


	\subsubsection{close\_out}
	\begin{syntax}
	close\_out (\var{filename}) \\
	close\_out (\var{filename}) \{ \var{options} \}
	\end{syntax}
	Close an external file that is open for writing. Example:
	\begin{code}
	close_out ("my_output.dat")
	\end{code}


	\subsection{Printing Data}

	\subsubsection{printf}
	\begin{syntax}
	printf \var{format-string-expr} \\
	printf \var{format-string-expr} (\var{data-objects})
	\end{syntax}
	Format \ttt{\var{data-objects}} according to \ttt{\var{format-string-expr}}
	and print the resulting string to standard output if the string variable
	\ttt{\$out\_file} is undefined. If \ttt{\$out\_file} is defined and the file
	with this name is open for writing, print to this file instead.

	Print a newline at the end if \ttt{?out\_advance} is true, otherwise don't
	finish the line.

	The \ttt{\var{format-string-expr}} must evaluate to a string. Formatting
	follows a subset of the rules for the \ttt{printf(3)} command in the \ttt{C}
	language. The supported rules are:
	\begin{itemize}
	\item All characters are printed as-is, with the exception of embedded
	conversion specifications.
	\item Conversion specifications are initiated by a percent (\verb\|%\|) sign and
	followed by an optional prefix flag, an optional integer value, an optional
	dot followed by another integer, and a mandatory letter as the conversion
	specifier.
	\item A percent sign immediately followed by another percent sign is
	interpreted as a single percent sign, not as a conversion specification.
	\item The number of conversion specifiers must be equal to the number of data
	objects. The data types must also match.
	\item The first integer indicates the minimum field width, the second one the
	precision. The field is expanded as needed.
	\item The conversion specifiers \ttt{d} and \ttt{i} are equivalent, they
	indicate an integer value.
	\item The conversion specifier \ttt{e} indicates a real value that should be
	printed in exponential notation.
	\item The conversion specifier \ttt{f} indicates a real value that should be
	printed in decimal notation without exponent.
	\item The conversion specifier \ttt{g} indicates a real value that should be
	printed either in exponential or in decimal notation, depending on its
	value.
	\item The conversion specifier \ttt{s} indicates a logical or string value
	that should be printed as a string.
	\item Possible prefixes are \verb\|#\| (alternate form, mandatory decimal point
	for reals), \verb\|0\| (zero padding), \verb\|-\| (left adjusted), \verb\|+\|
	(always print sign), `\verb\| \|' (print space before a positive number).
	\end{itemize}
	For more details, consult the \verb\|printf(3)\| manpage. Note that other
	conversions are not supported and will be rejected by \whizard.

	The data arguments are numeric, logical or string variables or expressions.
	Numeric expressions must be enclosed in parantheses. Logical expressions must
	be enclosed in parantheses prefixed by a question mark \verb\|?\|. String
	expressions must be enclosed in parantheses prefixed by a dollar sign
	\verb\|$\|. These forms behave as anonymous variables.

	Note that for simply printing a text string, you may call \ttt{printf} with
	just a format string and no data arguments.

	Examples:
	\begin{code}
	printf "The W mass is %8f GeV" (mW)

	int i = 2
	int j = 3
	printf "%i + %i = %i" (i, j, (i+j))

	string $directory = "/usr/local/share"
	string $file = "foo.dat"
	printf "File path: %s/%s" ($directory, $file)
	\end{code}
	There is a related \ttt{sprintf} function, cf.~Sec.~\ref{sec:sprintf}.

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\section{WHIZARD at next-to-leading order}
	\subsection{Prerequisites}
	A full NLO computation requires virtual matrix elements obtained from
	loop diagrams. Since \oMega\ cannot calculate such diagrams, external
	programs are used. \whizard\ has a generic interface to matrix-element
	generators that are BLHA-compatible.
	Explicit implementations exist for \gosam, \openloops\ and \recola.

	%%%%%

	\subsubsection{Setting up \gosam}

	The installation of \gosam\ is detailed on the HepForge page
	\url{https://gosam/hepforge.org}. We mention here some of the steps
	necessary to get it to be linked with \whizard.

	{\bf Bug in \gosam\ installation scripts:} In many versions of
	\gosam\ there is a bug in the installation scripts that is only
	relevant if \gosam\ is installed with superuser privileges. Then all
	files in \ttt{\$installdir/share/golem} do not have read privileges
	for normal users. These privileges must be given manually to all files
	in that directory.

	Prerequisites for \gosam\ to produce code for one-loop matrix elements
	are the scientific algebra program \ttt{form} and the generator of
	loop topologies and diagrams, \ttt{qgraf}.
	These can be accessed via their respective webpages
	\url{http://www.nikhef.nl/~form/} and
	\url{http://cfif.ist.utl.pt/~paulo/qgraf.html}. Note also that both
	\ttt{Java} and the Java runtime environment have to be installed in
	order for \gosam\ to properly work. Furthermore, \ttt{libtool}
	needs to be installed. A more convenient way to install \gosam, is the
	automatic installation script
	\url{https://gosam.hepforge.org/gosam_installer.py}.

	%%%%%

	\subsubsection{Setting up \openloops}
	\label{sec:openloops-setup}

	The installation of \openloops\ is explained in detail on the HepForge
	page \url{https://openloops.hepforge.org}. In the following, the main
	steps for usage with \whizard\ are summarized.

	Please note that at the moment, \openloops\ cannot be installed such
	that in almost all cases the explicit \openloops\ package directory
	has to be set via \ttt{--with-openloops=<openloops\_dir>}.

	\openloops\ can be checked out with
	\begin{code}
	git clone https://gitlab.com/openloops/OpenLoops.git
	\end{code}
	Note that \whizard\ only supports \openloops\ version that are at
	least 2.1.1 or newer. Alternatively, one can use the public beta
	version of \openloops, which can be checked out by the command
	\begin{code}
	git clone -b public_beta https://gitlab.com/openloops/OpenLoops.git
	\end{code}
	The program can be build by running \ttt{scons} or \ttt{./scons}, a
	local version that is included in the \openloops\ directory. This
	produces the script \ttt{./openloops}, which is the main hook for the
	further usage of the program.

	\openloops\ works by downloading prebuild process libraries, which have
	to be installed for each individual process. This requires the file
	\ttt{openloops.cfg}, which should contain
	the following content:
	\begin{code}
	[OpenLoops]
	process_repositories=public, whizard
	compile_extra=1
	\end{code}
	The first line instructs \openloops\ to also look for process libraries
	in an additional lepton collider repository. The second line triggers
	the inclusion of $N+1$-particle tree-level matrix elements in the
	process directory, so that a complete NLO calculation including real
	amplitudes can be performed only with \openloops.

	The libraries can then be installed via
	\begin{code}
	./openloops libinstall proc_name
	\end{code}
	A list of supported library names can be found on the \openloops\ web
	page. Note that a process library also includes all possible permutated
	processes. The process library \ttt{ppllj}, for example, can also be
	used to compute the matrix elements for $e^+ e^- \rightarrow q \bar{q}$
	(massless quarks only). The massive case of the top quark is handled in
	\ttt{eett}. Additionally, there are process libraries for top and gauge
	boson decays, \ttt{tbw}, \ttt{vjj}, \ttt{tbln} and \ttt{tbqq}.

	Finally, \openloops\ can be linked to \whizard\ during configuration by
	including
	\begin{code}
	--enable-openloops --with-openloops=$OPENLOOPS_PATH,
	\end{code}
	where \ttt{\$OPENLOOPS\_PATH} is the directory the \openloops\
	executable is located in. \openloops\ one-loop diagrams can then be
	used with the \sindarin\ option
	\begin{code}
	$loop_me_method = "openloops".
	\end{code}
	The functional tests which check the \openloops\ functionality require
	the libraries \ttt{ppllj}, \ttt{eett} and \ttt{tbw} to be installed (note
	that \ttt{eett} is not contained in \ttt{ppll}). During the
	configuration of \whizard, it is automatically checked that these two
	libraries, as well as the option \ttt{compile\_extra=1}, are present.

	\subsubsection{\openloops\ \sindarin\ flags}
	Several \sindarin\ options exist to control the behavior of \openloops.
	\begin{itemize}
	\item \ttt{openloops\_verbosity}:\\
	Decide how much \openloops\ output is printed. Can have values 0, 1
	and 2.
	\item \ttt{?openloops\_use\_cms}:\\
	Activates the complex mass scheme. For computations with decaying
	resonances like the top quark or W or Z bosons, this is the
	preferred option to avoid gauge-dependencies.
	\item \ttt{openloops\_phs\_tolerance}:\\
	Controls the exponent of \ttt{extra psp\_tolerance} in the BLHA
	interface, which is the numerical tolerance for the on-shell
	condition of external particles
	\item \ttt{openloops\_switch\_off\_muon\_yukawa}:\\
	Sets the Yukawa coupling of muons to zero in order to assure
	agreement with \oMega, which is possibly used for other
	components and per default does not take $H\mu\mu$ couplings
	into account.
	\item \ttt{openloops\_stability\_log}:\\
	Creates the directory \ttt{stability\_log}, which contains information
	about the performance of the matrix elements. Possible values are
	\begin{itemize}
	\item 0: No output (default),
	\item 1: On finish() call,
	\item 2: Adaptive,
	\item 3: Always
	\end{itemize}
	\item \ttt{?openloops\_use\_collier}: Use Collier as the reduction
	method (default true).
	\end{itemize}

	%%%%%

	\subsubsection{Setting up \recola}
	\label{sec:recola-setup}

	The installation of \recola\ is explained in detail on the HepForge page
	\url{https://recola.hepforge.org}. In the following the main steps for
	usage with \whizard\ are summarized. The minimal required version number
	of \recola\ is 1.3.0.

	\recola\ can be linked to \whizard\ during configuration by including
	\begin{code}
	--enable-recola
	\end{code}
	In case the \recola\ library is not in a standard path or a path
	accessible in the \ttt{LD\_LIBRARY\_PATH} (or
	\ttt{DYLD\_LIBRARY\_PATH}) of the operating system, then the option
	\begin{code}
	--with-recola=$RECOLA_PATH
	\end{code}
	can be set, where \ttt{\$RECOLA\_PATH} is the directory the
	\recola\ library is located in. \recola\ can then be used with the
	\sindarin\ option
	\begin{code}
	$method = "recola"
	\end{code}
	or any other of the matrix element methods.

	Note that there might be a clash of the \collier\ libraries when you
	have \collier\ installed both via \recola\ and via \openloops, but
	have compiled them with different \fortran\ compilers.

	%%%%%

	\subsection{NLO cross sections}
	An NLO computation can be switched on in \sindarin\ with
	\begin{code}
	process proc_nlo = in1, in2 => out1, ..., outN { nlo_calculation = <components> },
	\end{code}
	where the \ttt{nlo\_calculation} can be followed by a list of strings
	specifying the desired NLO-components to be integrated, i.e.
	\ttt{born}, \ttt{real}, \ttt{virtual}, \ttt{dglap}, (for hadron
	collisions) or \ttt{mismatch} (for the soft mismatch in
	resonance-aware computations) and \ttt{full}. The \ttt{full} option
	switches on all components and is required if the total NLO result is
	desired. For example, specifying
	\begin{code}
	nlo_calculation = born, virtual
	\end{code}
	will result in the computation of the Born and virtual component.

	The integration can be carried out in two different modes: Combined
	and separate integration. In the separate integration mode, each
	component is integrated individually, allowing for a good overview of
	their contributions to the total cross section and a fine tuned
	control over the iterations in each component. In the combined
	integration mode, all components are added up during integration so that
	the sum of them is evaluated. Here, only one integration will be
	displayed. The default method is the separate integration.

	The convergence of the integration can crucially be influenced by the
	presence of resonances. A better convergence is in this case achieved
	activating the resonance-aware FKS subtraction,
	\begin{code}
	$fks_mapping_type = "resonances".
	\end{code}
	This mode comes with an additional integration component, the
	so-called soft mismatch.

	Note that you can modify the number of iterations in each component with
	the multipliers:
	\begin{itemize}
	\item \ttt{mult\_call\_real} multiplies the number of calls to be used
	in the integration of the real component. A reasonable choice is
	\ttt{10.0} as the real phase-space is more complicated than the Born
	but the matrix elements evaluate faster than the virtuals.
	\item \ttt{mult\_call\_virt} multiplies the number of calls to be used
	in the integration of the virtual component. A reasonable choice is
	\ttt{0.5} to make sure that the fast Born component only contributes
	a negligible MC error compared to the real and virtual components.
	\item \ttt{mult\_call\_dglap} multiplies the number of calls to be used
	in the integration of the DGLAP component.
	\end{itemize}

	\subsection{Fixed-order NLO events}
	\label{ss:fixedorderNLOevents}
	Fixed-order NLO events can also be produced in three different modes:
	Combined weighted, combined unweighted and separated weighted.
	\begin{itemize}
	\item \textbf{Combined weighted}\\
	In the combined mode, one single integration grid is produced, from
	which events are generated with the total NLO weight. The
	corresponding event file contains $N$ events with born-like
	kinematics and weight equal to $\mathcal{B} + \mathcal{V} +
	\sum_{\alpha_r} \mathcal{C}_{\alpha_r}$, where $\mathcal{B}$ is the
	Born matrix element, $\mathcal{V}$ is the virtual matrix element and
	$\mathcal{C}_{\alpha_r}$ are the subtraction terms in each singular
	region. For resonance-aware processes, also the mismatch value is
	added. Each born-like event is followed by $N_{\text{phs}}$
	associated events with real kinematics, i.e. events where one
	additional QCD particle is present. The corresponding real
	matrix elements $\mathcal{R}_\alpha$ form the weight of these events.
	$N_{\text{phs}}$ is the number of distinct phase spaces. Two phase spaces
	are distinct if they have different resonance histories and/or have
	different emitters. So, two $\alpha_r$ can share the same phase
	space index.

	The combined event mode is activated by
	\begin{code}
	?combined_nlo_integration = true
	?unweighted = false
	?fixed_order_nlo_events = true
	\end{code}
	Moreover, the process must be specified at next-to-leading-order in its
	definition using \ttt{nlo\_calculation = full}. \whizard\ then
	proceeds as in the usual simulation mode. I.e. it first checks
	whether integration grids are already present and uses them if they
	fit. Otherwise, it starts an integration.
	\item \textbf{Combined unweighted}\\
	The unweighted combined events can be generated by using the
	\powheg\ mode, cf. also the next subsection, but disabling the
	additional radiation and Sudakov factors with the
	\ttt{?powheg\_disable\_sudakov} switch:
	\begin{code}
	?combined_nlo_integration = true
	?powheg_matching = true
	?powheg_disable_sudakov = true
	\end{code}
	This will produce events with Born kinematics and unit weights (as
	\ttt{?unweighted} is \ttt{true} by default). The events are
	unweighted by using $\mathcal{B} + \mathcal{V} + \sum_{\alpha_r}
	(\mathcal{C}_{\alpha_r} + \mathcal{R}_{\alpha_r})$. Of course, this
	only works when these weights are positive over the full
	phase-space, which is not guaranteed for all scales and regions at
	NLO. However, for many processes perturbation theory works nicely
	and this is not an issue.

	\item \textbf{Separate weighted}\\
	In the separate mode, grids and events are generated for each
	individual component of the NLO process. This method is preferable
	for complicated processes, since it allows to individually tune each
	grid generation. Moreover, the grid generation is then trivially
	parallelized. The event files either contain only Born
	kinematics with weight $\mathcal{B}$ or $\mathcal{V}$ (and mismatch
	in case of a resonance-aware process) or mixed Born and real
	kinematics for the real component like in the combined mode.
	However, the Born events have only the weight $\sum_{\alpha_r}
	\mathcal{C}_{\alpha_r}$ in this case.

	The separate event mode is activated by
	\begin{code}
	?unweighted = false
	?negative_weights = true
	?fixed_order_nlo_events = true
	\end{code}
	Note that negative weights have to be switched on because, in contrast
	to the combined mode, the total cross sections of the individual
	components can be negative.

	Also, the desired component has to appear in the process NLO
	specification, e.g. using \ttt{nlo\_calculation = real}.
	\end{itemize}
	Weighted fixed-order NLO events are supported by any output format that
	supports weights like the \ttt{HepMC} format and unweighted NLO events
	work with any format. The output can either be written to disk or put
	into a FIFO to interface it to an analysis program without writing
	events to file.

	The weights in the real event output, both in the combined and separate
	weighted mode, are divided by a factor $N_{\text{phs}} + 1$. This
	is to account for the fact that we artificially increase the number of
	events in the output file. Thus, the sum of all event weights correctly
	reproduces the total cross section.

	\subsection{\powheg\ matching}
	To match the NLO events with a parton shower, \whizard\ supports
	the \powheg\ matching. It generates a distribution according to
	\begin{align}
	\label{eq:powheg}
	\text{d}\sigma &= \text{d}\Phi_n \,{\bar{B}_{\text{s}}}\,\biggl(
	{\Delta_{\text{s}}}(p_T^{\text{min}}\bigr) +
	\text{d}\Phi_{\text{rad}}\,{\Delta_{\text{s}}}(k_{\text{T}}(\Phi_{\text{rad}})\bigr)
	{\frac{R_{\text{s}}}B}\biggr) \quad \text{where} \\
	{\bar{B}_{\text{s}}} &= {B} + {\mathcal{V}} + \text{d}\Phi_{\text{rad}}\,
	{\mathcal{R}_{\text{s}}} \quad \text{and} \\
	{\Delta_{\text{s}}}(p_T) &= \exp\left[- \int{\text{d}\Phi_{\text{rad}}}
	{\frac{R_{\text{s}}}{B}}\; \theta\left(k_T^2(\Phi_{\text{rad}}) -
	p_T^2\right)\right]\;.
	\end{align}
	The subscript s refers to the singular part of the real component, cf.
	to the next subsection. Eq.~\eqref{eq:powheg} produces either no or one
	additional emission. These events can then either be analyzed directly
	or passed on to the parton shower\footnote{E.g. \pythiaeight\ has
	explicit examples for \powheg\ input, see also
	\url{http://home.thep.lu.se/Pythia/pythia82html/POWHEGMerging.html}.}
	for the full simulation. You activate this with
	\begin{code}
	?fixed_order_nlo_events = false
	?combined_nlo_integration = true
	?powheg_matching = true
	\end{code}
	The $p_T^{\text{min}}$ of Eq.~\eqref{eq:powheg} can be set with
	\ttt{powheg\_pt\_min}. It sets the minimal scale for the \powheg\
	evolution and should be of order 1 GeV and set accordingly in the
	interfaced shower. The maximal scale is currently given by \ttt{sqrts}
	but should in the future be changeable with \ttt{powheg\_pt\_max}.

	Note that the \powheg\ event generation needs an additional grid for
	efficient event generation that is generated during integration if
	\ttt{?powheg\_matching = true} is set. Thus, this needs to be set before
	the \ttt{integrate} statement.
	Further options that steer the efficiency of this grid are
	\ttt{powheg\_grid\_size\_xi}, \ttt{powheg\_grid\_size\_y} and \ttt{powheg\_grid\_sampling\_points}.

	\subsection{Separation of finite and singular contributions}

	For both the pure NLO computations as well as the \powheg\ event
	generation, \whizard\ supports the partitioning of the real into finite
	and singular contributions with the string variable
	\begin{code}
	$real_partition_mode = "on"
	\end{code}
	The finite contributions, which by definition should not contain soft or
	collinear emissions, will then integrate like an ordinary LO integration
	with one additional particle. Similarly, the event generation will
	produce only real events without subtraction terms with Born kinematics
	for this additional finite component. The \powheg\ event generation
	will also only use the singular parts.

	The current implementation uses the following parametrization
	\begin{align}
	R &= R_{\text{fin}} + R_{\text{sing}} \;,\\
	R_{\text{sing}} &= R F(\Phi_{n+1}) \;,\\
	R_{\text{fin}} &= R (1-F(\Phi_{n+1})) \;,\\
	F(\Phi_{n+1}) &=
	\begin{cases}
	1 & \text{if} \quad\exists\,(i,j)\in\mathcal{P}_{\text{FKS}}\quad \text{with} \quad
	\sqrt{(p_i+p_j)^2} < h + m_i + m_j \\
	0 & \text{else}
	\end{cases} \;.
	\end{align}
	Thus, a point is {singular ($F=1$)}, if {any} of the {FKS tuples}
	forms an {invariant mass} that is {smaller than the hardness scale
	$h$}. This parameter is controlled in \sindarin\ with
	\ttt{real\_partition\_scale}.
	This simplifies in {massless case} to
	\begin{align}
	F(\Phi_{n+1}) =
	\begin{cases}
	1 & \text{if} \;\exists\,(i,j)\in\mathcal{P}_{\text{FKS}}\quad \text{with} \quad
	2 E_i E_j (1-\cos\theta_{ij}) < h^2 \\
	0 & \text{else}
	\end{cases} \;.
	\end{align}

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{Random number generators}
	\label{chap:rng}

	\section{General remarks}
	\label{sec:rng}

	The random number generators (RNG) are one of the crucialer points of Monte
	Carlo calculations, hence, giving those their ``randomness''. A decent
	multipurpose random generator covers
	\begin{itemize}
	\item reproducibility
	\item large period
	\item fast generation
	\item independence
	\end{itemize}
	of the random numbers. Therefore, special care is taken for the choice of the
	RNGs in \whizard{}. It is stated that \whizard{} utilizes \textit{pseudo}-RNGs,
	which are based on one (or more) recursive algorithm(s) and start-seed(s) to have
	reproducible sequences of numbers. In contrast, a genuine random generator relies
	on physical processes.

	\whizard\ ships with two completely different random number generators which can be
	selected by setting the \sindarin\ option
	\begin{code}
	$rng_method = "rng_tao"
	\end{code}
	Although, \whizard{} sets a default seed, it is adviced to use a different one
	\begin{code}
	seed = 175368842
	\end{code}
	note that some RNGs do not allow certain seed values (e.g. zero seed).

	\section{The TAO Random Number Generator}
	\label{sec:tao}

	The TAO (``The Art Of'') random number generator is a lagged Fibonacci
	generator based upon (signed) 32-bit integer arithmetic and was proposed by
	Donald E. Knuth and is implemented in the \vamp\ package.
	The TAO random number generator is the default RNG of \whizard{}, but can additionally
	be set as \sindarin\ option
	\begin{code}
	$rng_method = rng_tao
	\end{code}

	The TAO random number generators is a subtractive lagged Fibonacci generator
	\begin{equation*}
	x_{j} = \left( x_{j-k} - x_{j-L} \right) \mod 2^{30}
	\end{equation*}
	with lags $k = 100$ and $l = 37$ and period length $\rho = 2^{30} - 2$.

	\section{The RNGStream Generator}
	\label{sec:rngstream}

	The RNGStream \cite{L_Ecuyer:2002} was originally implemented in \cpp\ with
	floating point arithmetic and has been ported to \fortranOThree{}. The RNGstream
	can be selected by the \sindarin\ option
	\begin{code}
	$rng_method = "rng_stream"
	\end{code}

	The RNGstream supports multiple independent streams and substreams of random
	numbers which can be directly accessed.

	The main advantage of the RNGStream lies in the domain of parallelization where
	different worker have to access different parts of the random number stream to
	ensure numerical reproducibility. The RNGstream provides exactly this property with its
	(sub)stream-driven model.

	Unfortunately, the RNGStream can only be used in combination with \vamptwo{}.

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{Integration Methods}

	\section{The Monte-Carlo integration routine: \ttt{VAMP}}
	\label{sec:vamp}

	\vamp\ \cite{Ohl:1998jn}
	is a multichannel extension of the \vegas\ \cite{Lepage:1980dq}
	algorithm. For all possible singularities in the integrand, suitable
	maps and integration channels are chosen which are then weighted and
	superimposed to build the phase space parameterization. Both grids and
	weights are modified in the adaption phase of the integration.

	The multichannel integration algorithm is implemented as a
	\fortranNinetyFive\ library with the task of mapping out the integrand
	and finding suitable parameterizations being completely delegated to
	the calling program (\whizard\ core in this case). This makes the
	actual \vamp\ library completely agnostic of the model under
	consideration.

	\section{The next generation integrator: \ttt{VAMP2}}
	\label{sec:vamp2}

	\vamptwo\ is a modern implementation of the integrator package \vamp\ written
	in \fortranOThree\, providing the same features. The backbone integrator is
	still \vegas\ \cite{Lepage:1980dq}, although implemented differently as in
	\vamp{}.

	The main advantage over \vamp\ is the overall faster integration due to the usage
	of \fortranOThree{}, the possible usage of different random number generators
	and the complete parallelization of \vegas\ and the multichannel integration.

	\vamptwo{} can be set by the \sindarin{} option
	\begin{code}
	$integration_method = "vamp2"
	\end{code}

	It is said that the generated grids between \vamp{} and \vamptwo{} are
	incompatible.

	\subsection{Multichannel integration}
	\label{sec:multi-channel}

	The usual matrix elements do not factorise with respect to their integration
	variables, thus making an direct integration ansatz with VEGAS
	unfavorable.\footnote{One prerequisite for the VEGAS algorithm is that the
	integral factorises, and such produces only the best results for those.} Instead, we
	apply the multichannel ansatz and let VEGAS integrate each channel in a
	factorising mapping.

	The different structures of the matrix element are separated by a partition of
	unity and the respective mappings, such that each structure factorise at least
	once. We define the mappings $\phi_i : U \mapsto \Omega$, where $U$ is the unit
	hypercube and $\Omega$ the physical phase space. We refer to each mapping as a
	\textit{channel}. Each channel then gives rise to a probability density $g_i : U
	\mapsto [0, \infty)$, normalised to unity
	\begin{equation*}
	\int_0^1 g_i(\phi_i^{-1}(p)) \left\| \frac{\partial \phi_i^{-1}}{\partial p} \right\| \mathrm{d}\mu(p) = 1, \quad g_i(\phi_i^{-1}(p)) \geq 0,
	\end{equation*}
	written for a phase space point $p$ using the mapping $\phi_i$.
	The \textit{a-priori} channel weights $\alpha_i$ are defined as partition of
	unity by $\sum_{i\in I} \alpha_i = 1$ and $0 \leq \alpha_i \leq 1$. The overall
	probability density $g$ of a random sample is then obtained by
	\begin{equation*}
	g(p) = \sum_{i \in I} \alpha_i g_i(\phi_i^{-1}(p)) \left\| \frac{\partial \phi_i^{-1}}{\partial p} \right\|,
	\end{equation*}
	which is also a non-negative and normalized probability density.

	We reformulate the integral
	\begin{equation*}
	I(f) = \sum_{i \in I} \alpha_i \int_\Omega g_i(\phi_i^{-1}(p)) \left\| \frac{\partial \phi_i^{-1}}{\partial p} \right\| \frac{f(p)}{g(p)} \mathrm{d}\mu(p).
	\end{equation*}
	The actual integration of each channel is then done by VEGAS, which shapes the $g_i$.

	\subsection{VEGAS}
	\label{sec:vegas}

	VEGAS is an adaptive and iterative Monte Carlo algorithm for integration using
	importance sampling. After each iteration, VEGAS adapts the probability density
	$g_i$ using information collected while sampling. For independent
	integration variables, the probability density factorises $g_i = \prod_{j =
	1}^{d} g_{i,j}$ for each integration axis and each (independent) $g_{i,j}$ is
	defined by a normalised step function
	\begin{equation*}
	g_{i,j} (x_j) = \frac{1}{N\Delta x_{j,k}}, \quad x_{j,k} - \Delta x_{j,k} \leq x_{j} < x_{j,k},
	\end{equation*}
	where the steps are $0 = x_{j, 0} < \cdots < x_{j,k} < \cdots < x_{j,N} = 1$ for
	each dimension $j$.
	The algorithm randomly selects for each dimension a bin and a position inside
	the bin and calculates the respective $g_{i,j}$.

	\subsection{Channel equivalences}
	\label{sec:equivalences}

	The automated mulitchannel phasespace configuration can lead to a surplus of
	degrees of freedom, e.g. for a highly complex process with a large number of
	channels (VBS). In order to marginalize the redundant degrees of freedom of
	phasespace configuration, the adaptation distribution of the grids are aligned in accordance to their
	phasespace relation, hence the binning of the grids is equialized. These equivalences are activated by
	default for \vamp{} and \vamptwo{}, but can be steered by:

	\begin{code}
	?use_vamp_equivalences = true
	\end{code}

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{Phase space parameterizations}

	\section{General remarks}

	\whizard\ as a default performs an adaptive multi-channel Monte-Carlo
	integration. Besides its default phase space algorithm, \ttt{wood}, to
	be detailed in Sec.~\ref{sec:wood}, \whizard\ contains a phase space
	method \ttt{phs\_none} which is a dummy method that is intended for
	setups of processes where no phase space integration is needed, but
	the program flow needs a (dummy) integrator for internal
	consistency. Then, for testing purposes, there is a single-channel
	phase space integrator, \ttt{phs\_single}. From version 2.6.0 of
	\whizard\ on, there is also a second implementation of the \ttt{wood}
	phase space algorithm, called \ttt{fast\_wood},
	cf. Sec.~\ref{sec:fast_wood}, whose implementation differs technically
	and which therefore solves certain technical flaws of the \ttt{wood}
	implementation.
	Additionally, \whizard\ supports single-channel, flat phase-space using RAMBO
	(on diet).

	%%%

	\section{The flat method: \ttt{rambo}}
	\label{sec:rambo}

	The \ttt{RAMBO} algorithm produces a flat phase-space with constant volume for
	massless particles. \ttt{RAMBO} was originally published in
	\cite{Kleiss:1985gy}. We use the slim version, called \ttt{RAMBO} on diet,
	published in \cite{Platzer:2013esa}.
	The overall weighting efficiency of the algorithm is unity for massless
	final-state particles. For the massive case, the weighting efficiency of unity will
	decrease rendering the algorithm less efficient. But in most cases, the
	invariants are in regions of phase space where they are much larger than the
	masses of the final-state particles.

	We provide the \ttt{RAMBO} mainly for cross checking our
	implementation and do not recommend it for real world application,
	even though it can be used as one. The \ttt{RAMBO} method becomes
	useful as a fall-back option if the standard algorithm fails for
	physical reasons, see, e.g., Sec.~\ref{sec:ps_anomalous}.

	%%%

	\section{The default method: \ttt{wood}}
	\label{sec:wood}

	The \ttt{wood} algorithm classifies different phase space channels
	according to their importance for a full scattering or decay process
	following heuristic rules. For that purpose, \whizard\ investigates
	the kinematics of the different channels depending on the total
	center-of-mass energy (or the mass of the decaying particle) and the
	masses of the final-state particles.

	The \ttt{wood} phase space inherits its name from the naming schemes
	of structures of increasing complexities, namely trees, forests and
	groves. Simply stated, a phase-space forest is a collection of
	phase-space trees. A phase-space tree is a parameterization for a
	valid channel in the multi-channel adaptive integration, and each
	variable in the a tree corresponds to an integration dimension,
	defined by an appropriate mapping of the $(0,1)$ interval of the unit
	hypercube to the allowed range of the corresponding integration
	variable. The whole set of these phase-space trees, collected in a
	phase-space forest object hence contains all parameterizations of the
	phase space that \whizard\ will use for a single hard process. Note
	that processes might contain flavor sums of particles in the final
	state. As \whizard\ will use the same phase space parameterization for
	all channels for this set of subprocesses, all particles in those
	flavor sums have to have the same mass. E.g. in the definition of a
	"light" jet consisting of the first five quarks and antiquarks,
	\begin{code}
	alias jet = u:d:s:c:b:U:D:S:C:B
	\end{code}
	all quarks including strange, charm and bottom have to be massless for
	the phase-space integration. \whizard\ can treat processes with
	subprocesses having final-state particles with different masses in an
	"additive" way, where each subprocess will become a distinct component
	of the whole process. Each process component will get its own
	phase-space parameterization, such that they can allow for different
	masses. E.g. in a 4-flavor scheme for massless $u,d,s,c$ quarks one
	can write
	\begin{code}
	alias jet = u:d:s:c:U:D:S:C
	process eeqq = e1, E1 => (jet, jet) + (b, B)
	\end{code}
	In that case, the parameterizations will be for massless final state
	quarks for the first subprocess, and for massive $b$ quarks for the
	second subprocess. In general, for high-energy lepton colliders, the
	difference would not matter much, but performing the integration
	e.g. for $\sqrt{s} = 11$ GeV, the difference will be
	tremendous. \whizard\ avoids inconsistent phase-space
	parameterizations in that way.

	As a multi-particle process will contain hundred or thousands of
	different channels, the different integration channels (trees) are
	grouped into so called {\em groves}. All channels/trees in the same
	grove share a common weight for the phase-space integration, following
	the assumption that they are related by some approximate symmetry. The
	\vamp\ adaptive multi-channel integrator (cf. Sec.~\ref{sec:vamp})
	allows for equivalences between different integration channels. This
	means that trees/channels that are related by an exact symmetry are
	connected by an array of these equivalences.

	The phase-space setup, i.e. the detailed structure of trees and
	forests, are written by \whizard\ into a phase-space file that has the
	same name as the corresponding process (or process component) with the
	suffix \ttt{.phs}. For the \ttt{wood} phase-space method this file is
	written by a \fortran\ module which constructs a similar tree-like
	structure as the directed acyclical graphs (DAGs) in the
	\oMega\ matrix element generator but in a less efficient way.

	In some very rare cases with externally generated models
	(cf. Chapter~\ref{chap:extmodels}) the phase-space generation has been
	reported to fail as \whizard\ could not find a valid phase-space
	channel. Such pathological cases cannot occur for the hard-coded model
	implementations inside \whizard. They can only happen if there are in
	principle two different Feynman diagrams contributing to the same
	phase-space channel and \whizard\ considers the second one as
	extremely subleading (and would hence drop it). If for some reason
	however the first Feynman diagram is then absent, no phase-space
	channel could be found. This problem cannot occur with the
	\ttt{fast\_wood} implementation discussed in the next section,
	cf.~\ref{sec:fast_wood}.

	The \ttt{wood} algorithms orders the different groves of phase-space
	channels according to a heuristic importance depending on the
	kinematic properties of the different phase-space channels in the
	groves. A phase-space (\ttt{.phs}) file looks typically like this:
	\begin{code}
	process sm_i1

	! List of subprocesses with particle bincodes:
	! 8 4 1 2
	! e+ e- => mu+ mu-
	! 8 4 1 2

	md5sum_process = "1B3B7A30C24664A73D3D027382CFB4EF"
	md5sum_model_par = "7656C90A0B2C4325AD911301DACF50EB"
	md5sum_phs_config = "6F72D447E8960F50FDE4AE590AD7044B"
	sqrts = 1.000000000000E+02
	m_threshold_s = 5.000000000000E+01
	m_threshold_t = 1.000000000000E+02
	off_shell = 2
	t_channel = 6
	keep_nonresonant = T

	! Multiplicity = 2, no resonances, 0 logs, 0 off-shell, s-channel graph
	grove #1
	! Channel #1
	tree 3

	! Multiplicity = 1, 1 resonance, 0 logs, 0 off-shell, s-channel graph
	grove #2
	! Channel #2
	tree 3
	map 3 s_channel 23 ! Z
	\end{code}
	The first line contains the process name, followed by a list of
	subprocesses with the external particles and their binary codes. Then
	there are three lines of MD5 check sums, used for consistency
	checks. \whizard\ (unless told otherwise) will check for the existence
	of a phase-space file, and if the check sum matches, it will reuse the
	existing file and not generate it again. Next, there are several
	kinematic parameters, namely the center-of-mass energy of the process,
	\ttt{sqrts}, and two mass thresholds, \ttt{m\_threshold\_s} and
	\ttt{m\_threshold\_t}. The latter two are kinematical thresholds,
	below which \whizard\ will consider $s$-channel and $t$-channel-like
	kinematic configurations as effectively massless, respectively. The
	default values shown in the example have turned out to be optimal
	values for Standard Model particles. The two integers \ttt{off\_shell}
	and \ttt{t\_channel} give the number of off-shell lines and of
	$t$-channel lines that \whizard\ will allow for finding valid
	phase-space channels, respectively. This neglects extremley multi-peripheral
	background-like diagram constellations which are very subdominamnt
	compared to resonant signal processes. The final flag specifies
	whether \whizard\ will keep non-resonant phase-space channels
	(default), or whether it will focus only on resonant situations.

	After this header, there is a list of all groves, i.e. collections of
	phase-space channels which are connected by quasi-symmetries, together
	with the corresponding multiplicity of subchannels in that
	grove. In the phase-space file behind the multiplicity,
	\whizard\ denotes the number of (massive) resonances, logarithmcally
	enhanced kinematics (e.g. collinear regions), and number of off-shell
	lines, respectively. The final entry in the grove header notifies
	whether the diagrams in that grove have $s$-channel topologies, or
	count the number of corresponding $t$-channel lines.

	Another example is shown here,
	\begin{code}
	! Multiplicity = 3, no resonances, 2 logs, 0 off-shell, 1 t-channel line
	grove #1
	! Channel #1
	tree 3 12
	map 3 infrared 22 ! A
	map 12 t_channel 2 ! u
	! Channel #2
	tree 3 11
	map 3 infrared 22 ! A
	map 11 t_channel 2 ! u
	! Channel #3
	tree 3 20
	map 3 infrared 22 ! A
	map 20 t_channel 2 ! u
	! Channel #4
	tree 3 19
	map 3 infrared 22 ! A
	map 19 t_channel 2 ! u
	\end{code}
	where \whizard\ notifies in different situations a photon exchange as
	\ttt{infrared}. So it detects a possible infrared singularity where a
	particle can become arbitrarily soft. Such a situation can tell the
	user that there might be a cut necessary in order to get a meaningful
	integration result.

	The phase-space setup that is generated and used by the \ttt{wood}
	phase-space method can be visualized using the \sindarin\ option
	\begin{code}
	?vis_channels = true
	\end{code}

	The \ttt{wood} phase-space method can be invoked with the
	\sindarin\ command
	\begin{code}
	$phs_method = "wood"
	\end{code}
	Note that this line is unnecessary, as \ttt{wood} is the default
	phase-space method of \whizard.

	%%%%%

	\section{A new method: \ttt{fast\_wood}}
	\label{sec:fast_wood}

	This method (which is available from version 2.6.0 on) is an
	alternative implementation of the \ttt{wood} phase-space algorithm. It
	uses the recursive structures inside the \oMega\ matrix element
	generator to generate all the structures needed for the different
	phase-space channels. In that way, it can avoid some of the
	bottlenecks of the \ttt{wood} \fortran\ implementation of the
	algorithm. On the other hand, it is only available if the
	\oMega\ matrix element generator has been enabled (which is the
	default for \whizard). The \ttt{fast\_wood} method is then invoked via
	\begin{code}
	?omega_write_phs_output = true
	$phs_method = "fast_wood"
	\end{code}
	The first option is necessary in order to tell \oMega\ to write out
	the output needed for the \ttt{fast\_wood} parser in order to generate
	the phase-space file. This is not enabled by default in order not to
	generate unnecessary files in case the default method \ttt{wood} is
	used.

	So the \ttt{fast\_wood} implementation of the \ttt{wood} phase-space
	algorithm parses the tree-like represenation of the recursive set of
	one-particle off-shell wave functions that make up the whole amplitude
	inside \oMega\ in the form of a directed acyclical graph (DAG) in
	order to generate the phase-space (\ttt{.phs}) file
	(cf. Sec.~\ref{sec:wood}). In that way, the algorithm makes sure that
	only phase-space channels are generated for which there are indeed
	(sub)amplitudes in the matrix elements, and this also allows to
	exclude vetoed channels due to restrictions imposed on the matrix
	elements from the phase-space setup (cf. next
	Sec.~\ref{sec:ps_restrictions}).

	%%%%%

	\section{Phase space respecting restrictions on subdiagrams}
	\label{sec:ps_restrictions}

	The \fortran\ implementation of the \ttt{wood} phase-space does not
	know anything about possible restrictions that maybe imposed on the
	\oMega\ matrix elements, cf. Sec.~\ref{sec:process options}.
	Consequently, the \ttt{wood} phase space also generates phase-space
	channels that might be absent when restrictions are imposed. This is
	not a principal problem, as in the adaptation of the phase-space
	channels \whizard's integrator \vamp\ will recognize that there is
	zero weight in that channel and will drop the channel (stop sampling
	in that channel) after some iterations. However, this is a waste of
	ressources as it is in principle known that this channel is
	absent. Using the \ttt{fast\_wood} phase-space algorithm
	(cf. Sec.~\ref{sec:fast_wood} will take restrictions into account, as
	\oMega\ will not generate trees for channels that are removed with the
	restrictions command. So it advisable for the user in the case of very
	complicated processes with restrictions to use the \ttt{fast\_wood}
	phase-space method to make \whizard\ generation and integration of the
	phase space less cumbersome.

	%%%%%

	\section{Phase space for processes forbidden at tree level}
	\label{sec:ps_anomalous}

	The phase-space generators \ttt{wood} and \ttt{fast\_wood} are
	intended for tree-level processes with their typical patterns of
	singularities, which can be read off from Feynman graphs. They can
	and should be used for loop-induced or for externally provided matrix
	elements as long as \whizard\ does not provide a dedicated phase-space
	module.

	Some scattering processes do not occur at tree level but become
	allowed if loop effects are included in the calculation. A simple
	example is the elastic QED process
	\begin{displaymath}
	A\quad A \longrightarrow A\quad A
	\end{displaymath}
	which is mediated by a fermion loop. Similarly, certain applications
	provide externally provided or hand-taylored matrix-element code that
	replaces the standard \oMega\ code.

	Currently, \whizard's phase-space parameterization is nevertheless
	tied to the \oMega\ generator, so for tree-level forbidden processes
	the phase-space construction process will fail.

	There are two possible solutions for this problem:
	\begin{enumerate}
	\item
	It is possible to provide the phase-space parameterization
	information externally, by supplying an appropriately formatted
	\ttt{.phs} file, bypassing the automatic algorithm. Assuming that
	this phase-space file has been named \ttt{my\_phase\_space.phs}, the
	\sindarin\ code should contain the following:
	\begin{code}
	?rebuild_phase_space = false
	$phs_file = "my_phase_space.phs"
	\end{code}
	Regarding the contents of this file, we recommend to generate an
	appropriate \ttt{.phs} for a similar setup, using the standard
	algorithm. The generated file can serve as a template, which can be
	adapted to the particular case.

	In detail, the \ttt{.phs} file consists of entries that specify the
	process, then a standard header which contains MD5 sums and such --
	these variables must be present but their values are irrelevant for
	the present case --, and finally at least one \ttt{grove} with
	\ttt{tree} entries that specify the parameterization. Individual
	parameterizations are built from the final-state and initial-state
	momenta (in this order) which we label in binary form as
	$1,2,4,8,\dots$. The actual tree consists of iterative fusions of
	those external lines. Each fusion is indicated by the number that
	results from adding the binary codes of the external momenta that
	contribute to it.

	For instance, a valid phase-space tree for the process $AA\to AA$ is
	given by the simple entry
	\begin{code}
	tree 3
	\end{code}
	which indicates that the final-state momenta $1$ and $2$ are
	combined to a fusion $1+2=3$. The setup is identical to a process
	such as $e^+e^-\to\mu^+\mu^-$ below the $Z$ threshold. Hence, we
	can take the \ttt{.phs} file for the latter process, replace the
	process tag, and use it as an external phase-space file.
	\item
	For realistic applications of \whizard\ together with one-loop
	matrix-element providers, the actual number of final-state particles may be
	rather small, say $2,3,4$. Furthermore, one-loop processes which are
	forbidden at tree level do not contain soft or collinear
	singularities. In this situation, the \ttt{RAMBO}
	phase-space integration method, cf.\ Sec.~\ref{sec:rambo} is a
	viable alternative which does not suffer from the problem.
	\end{enumerate}



	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{Methods for Hard Interactions}
	\label{chap:hardint}

	The hard interaction process is the core of any physics simulation
	within an MC event generator. One tries to describe the dominant
	particle interaction in the physics process of interest at a given
	order in perturbation theory, thereby making use of field-theoretic
	factorization theorems, especially for QCD, in order to separate
	non-perturbative physics like parton distribution functions (PDFs) or
	fragmentation functions from the perturbative part. Still, it is in
	many cases not possible to describe the perturbative part completely
	by means of fixed-order hard matrix elements: in soft and/or collinear
	regions of phase space, multiple emission of gluons and quarks (in
	general QCD jets) and photons necessitates a resummation, as large
	logarithms accompany the perturbative coupling constants and render
	fixed-order perturbation theory unreliable. The resummation of these
	large logarithms can be done analytically or (semi-)numerically,
	however, usually only for very inclusive quantities. At the level of
	exclusive events, these phase space regions are the realm of (QCD and
	also QED) parton showers that approximate multi-leg matrix elements
	from the hard perturbative into to the soft-/collinear regime.

	The hard matrix elements are then the core building blocks of the
	physics description inside the MC event generator. \whizard\ generates
	these hard matrix elements at tree-level (or sometimes for
	loop-induced processes using effective operators as insertions) as
	leading-order processes. This is done by the \oMega\ subpackage that
	is automatically called by \whizard. Besides these physical matrix
	elements, there exist a couple of methods to generate dummy matrix
	elements for testing purposes, or for generating beam profiles and
	using them with externally linked special matrix elements.

	Especially for one-loop processes (next-to-leading order for
	tree-allowed processes or leading-order for loop-induced processes),
	\whizard\ allows to use matrix elements from external providers, so
	called OLP programs (one-loop providers). Of course, all of these
	external packages can also generate tree-level matrix elements, which
	can then be used as well in \whizard.

	We start the discussion with the two different options for test matrix
	elements, internal test matrix elements with no generated compiled code
	in Sec.~\ref{sec:test_me} and so called template matrix elements with
	actual \fortran\ code that is compiled and linked, and can also be
	modified by the user in Sec.~\ref{sec:template_me}. Then, we move to
	the main matrix element method by the matrix element generator
	\oMega\ in Sec.~\ref{sec:omega_me}. Matrix elements from the external
	matrix element generators are discussed in the order of which
	interfaces for the external tools have been implemented: \gosam\ in
	Sec.~\ref{sec:gosam_me}, \openloops\ in Sec.~\ref{sec:openloops_me},
	and \recola\ in Sec.~\ref{sec:recola_me}.

	%%%%%

	\section{Internal test matrix elements}
	\label{sec:test_me}

	This method is merely for internal consistency checks inside \whizard,
	and is not really intended to be utilized by the user. The method is
	invoked by
	\begin{code}
	$method = "unit_test"
	\end{code}
	This particular method is only applicable for the internal test model
	\ttt{Test.mdl}, which just contains a Higgs boson and a top
	quark. Technically, it will also works within model specifications
	for the Standard Model, or the Minimal Supersymmetric Standard Model
	(MSSM), or all models which contain particles named as \ttt{H} and
	\ttt{t} with PDG codes 25 and 6, respectively. So, the models
	\ttt{QED} and {QCD} will not work. Irrespective of what is given in
	the \sindarin\ file as a scattering input process, \whizard\ will
	always take the process
	\begin{code}
	model = SM
	process <proc_name>= H, H => H, H
	\end{code}
	or for the test model:
	\begin{code}
	model = Test
	process <proc_name>= s, s => s, s
	\end{code}
	as corresponding process. (This is the same process, just with
	differing nomenclature in the different models). No matrix element
	code is generated and compiled, the matrix element is completely
	internal, included in the \whizard\ executable (or library), with a
	unit value for the squared amplitude. The integration will always be
	performed for this particularly process, even if the user provides a
	different process for that method. Hence, the result will always be
	the volume of the relativistic two-particle phase space. The only two
	parameters that influence the result are the collider energy,
	\ttt{sqrts}, and the mass of the Higgs particle with PDG code 25 (this
	mass parameter can be changed in the model \ttt{Test} as \ttt{ms},
	while it would be \ttt{mH} in the Standard Model \ttt{SM}.

	It is also possible to use a test matrix element, again internal, for
	decay processes, where again \whizard\ will take a predefined process:
	\begin{code}
	model = SM
	process <proc_name> = H => t, tbar
	\end{code}
	in the \ttt{SM} model or
	\begin{code}
	model = Test
	process <proc_name> = s => f, fbar
	\end{code}
	Again, this is the same process with PDG codes $25 \to 6 \; -6$ in the
	corresponding models. Note that in the model \ttt{SM} the mass of the
	quark is set via the variable \ttt{mtop}, while it is \ttt{mf} in the
	model \ttt{Test}.

	Besides the fact that the user always gets a fixed process and cannot
	modify any matrix element code by hand, one can do all things as for a
	normal process like generating events, different weights, testing
	rebuild flags, using different setups and reweight events
	accordingly. Also factorized processes with production and decay can
	be tested that way.

	In order to avoid confusion, it is highly recommended to use this
	method \ttt{unit\_test} only with the test model setup, model
	\ttt{Test}.

	On the technical side, the method \ttt{unit\_test} does not produce a
	process library (at least not an externally linked one), and also not
	a makefile in order to modify any process files (which anyways do not
	exist for that method). Except for the logfiles and the phase space
	file, all files are internal.

	%%%%%

	\section{Template matrix elements}
	\label{sec:template_me}

	Much more versatile for the user than the previous matrix element
	method in~\ref{sec:test_me}, are two different methods with constant
	template matrix elements. These are written out as \fortran\ code by
	the \whizard\ main executable (or library), providing an interface
	that is (almost) identical to the matrix element code produced by the
	\oMega\ generator (cf. the next section,
	Sec.~\ref{sec:omega_me}. There are actually two different methods for
	that purpose, providing matrix elements with different normalizations:
	\begin{code}
	$method = "template"
	\end{code}
	generates matrix elements which give after integration over phase
	space exactly one. Of course, for multi-particle final states the
	integration can fluctuate numerically and could then give numbers that
	are only close to one but not exactly one. Furthermore, the
	normalization is not exact if any of the external particles have
	non-zero masses, or there are any cuts involved. But otherwise, the
	integral from \whizard\ should give unity irrespective of the number
	of final state particles.

	In contrast to this, the second method,
	\begin{code}
	$method = "template_unity"
	\end{code}
	gives a unit matrix elements, or rather a matrix element that contains
	helicity and color averaging factors for the initial state and the
	square root of the factorials of identical final state particles in
	the denominator. Hence, integration over the final state momentum
	configuration gives a cross section that corresponds to the volume of
	the $n$-particle final state phase space, divided by the corresponding
	flux factor, resulting in
	\begin{equation}
	\sigma(s, 2 \to 2,0) = \frac{3.8937966\cdot 10^{11}}{16\pi} \cdot
	\frac{1}{s \text{[GeV]}^2} \; \text{fb}
	\end{equation}
	for the massless case and
	\begin{equation}
	\sigma(s, 2 \to 2,m_i) = \frac{3.8937966\cdot 10^{11}}{16\pi} \cdot
	\sqrt{\frac{\lambda (s,m_3^2,m_4^2)}{\lambda (s,m_1^2,m_2^2)}}
	\cdot \frac{1}{s \text{[GeV]}^2} \; \text{fb}
	\end{equation}
	for the massive case. Here, $m_1$ and $m_2$ are the masses of the
	incoming, $m_3$ and $m_4$ the masses of the outgoing particles, and
	$\lambda(x,y,z) = x^2 + y^2 + z^2 - 2xy - 2xz - 2yz$.

	For the general massless case with no cuts, the integral should be
	exactly
	\begin{equation}
	\sigma(s, 2\to n, 0) = \frac{(2\pi)^4}{2 s}\Phi_n(s)
	= \frac{1}{16\pi s}\,\frac{\Phi_n(s)}{\Phi_2(s)},
	\end{equation}
	where the volume of the massless $n$-particle phase space is
	given by
	\begin{equation}\label{phi-n}
	\Phi_n(s) = \frac{1}{4(2\pi)^5} \left(\frac{s}{16\pi^2}\right)^{n-2}
	\frac{1}{(n-1)!(n-2)!}.
	\end{equation}
	For $n\neq2$ the phase space volume is dimensionful, so the
	units of the integral are $\fb\times\GeV^{2(n-2)}$. (Note that for
	physical matrix elements this is compensated by momentum factors from
	wave functions, propagators, vertices and possibly dimensionful
	coupling constants, but here the matrix element is just equal to
	unity.)

	Note that the phase-space integration for the \ttt{template} and
	\ttt{template\_unity} matrix element methods is organized in the same
	way as it would be for the real $2\to n$ process. Since such a phase
	space parameterization is not optimized for the constant matrix
	element that is supplied instead, good convergence is not guaranteed.
	(Setting \ttt{?stratified = true} may be helpful here.)

	The possibility to call a dummy matrix element with this method allows
	to histogram spectra or structure functions: Choose a trivial process
	such as $uu\to dd$, select the \ttt{template\_unity} method, switch
	on structure functions for one (or both) beams, and generate events.
	The distribution of the final-state mass squared reflects the $x$
	dependence of the selected structure function.

	Furthermore, the constant in the source code of the unit matrix
	elements can be easily modified by the user with their \fortran\ code
	in order to study customized matrix elements. Just rerun
	\whizard\ with the \ttt{--recompile} option after the modification of
	the matrix element code.

	Both methods, \ttt{template} and \ttt{template\_unity} will also work
	even if no \ocaml\ compiler is found or used and consequently the
	\oMega\ matrix elemente generator (cf. Sec.~\ref{sec:omega_me} is
	disable. The methods produce a process library for their corresponding
	processes, and a makefile, by which \whizard\ steers compilation and
	linking of the process source code.

	%%%%%

	\section{The O'Mega matrix elements}
	\label{sec:omega_me}

	\oMega\ is a subpackage of \whizard, written in \ocaml, which can
	produce matrix elements for a wide class of implemented physics models
	(cf. Sec.~\ref{sec:smandfriends} and \ref{sec:bsmmodels} for a list of
	all implemented physics models), and even almost arbitrary models when
	using external Lagrange level tools, cf. Chap.~\ref{chap:extmodels}.
	There are two different variants for matrix elements from \oMega:
	the first one is invoked as
	\begin{code}
	$method = "omega"
	\end{code}
	and is the default method for \whizard. It produces matrix element as
	\fortran\ code which is then compiled and linked. An alternative
	method, which for the moment is only available for the Standard Model
	and its variants as well models which are quite similar to the SM,
	e.g. the Two-Higgs doublet model or the Higgs-singlet extension. This
	method is taken when setting
	\begin{code}
	$method = "ovm"
	\end{code}
	The acronym \ttt{ovm} stands for \oMega\ Virtual Machine (OVM). The
	first (default) method (\ttt{omega}) of \oMega\ matrix elements
	produces \fortran\ code for the matrix elements,that is compiled by
	the same compiler with which \whizard\ has been compiled. The OVM
	method (\ttt{ovm}) generates an \ttt{ASCII} file with so called op
	code for operations. These are just numbers which tell what numerical
	operations are to be performed on momenta, wave functions and vertex
	expression in order to yield a complex number for the amplitude. The
	op codes are interpreted by the OVM in the same as a Java Virtual
	Machine. In both cases, a compiled \fortran\ is generated which for
	the \ttt{omega} method contains the full expression for the matrix
	element as \fortran\ code, while for the \ttt{ovm} method this is the
	driver file of the OVM. Hence, for the \ttt{ovm} method this file
	always has roughly the same size irrespective of the complexity of the
	process. For the \ttt{ovm} method, there will also be the \ttt{ASCII}
	file that contains the op codes, which has a name with an \ttt{.hbc}
	suffix: \ttt{<process\_name>.hbc}.

	For both \oMega\ methods, there will be a process library created as
	for the template matrix elements (cf. Sec.~\ref{sec:template_me})
	named \ttt{default\_lib.f90} which can be given a user-defined name
	using the \ttt{library = "<library>"} command. Again, for both methods
	\ttt{omega} and \ttt{ovm}, a makefile named
	\ttt{<library>\_lib.makefile} is generated by which \whizard\ steers
	compilation, linking and clean-up of the process sources. This
	makefile can handily be adapted by the user in case she or he wants to
	modify the source code for the process (in the case of the source code
	method).

	Note that \whizard's default ME method via \oMega\ allows the user to
	specify many different options either globally for all processes in
	the \sindarin, or locally for each process separately in curly
	brackets behind the corresponding process definition. Examples are
	\begin{itemize}
	\item
	Restrictions for the matrix elements like the exclusion of
	intermediate resonances, the appearance of specific vertices or
	coupling constants in the matrix elments. For more details on this
	cf. Sec.~\ref{subsec:restrictions}.
	\item
	Choice of a specific scheme for the width of massive intermediate
	resonances, whether to use constant width, widths only in
	$s$-channel like kinematics (this is the default), a fudged-width
	scheme or the complex-mass scheme. The latter is actually steered as
	a specific scheme of the underlying model and not with a specific
	\oMega\ command.
	\item
	Choice of the electroweak gauge for the amplitude. The default is
	the unitary gauge.
	\end{itemize}
	With the exception of the restrictions steered by the
	\ttt{\$restrictions = "<restriction>"} string expression, these options
	have to be set in their specific \oMega\ syntax verbatim via the
	string command \ttt{\$omega\_flags = "<expr>"}.



	%%%%%

	\section{Interface to GoSam}
	\label{sec:gosam_me}

	One of the supported methods for automated matrix elements from
	external providers is for the \gosam\ package. This program package
	which is a combination of \python\ scripts and \fortran\ libraries,
	allows both for tree and one-loop matrix elements (which is leading or
	next-to-leading order, depending on whether the corresponding process
	is allowed at the tree level or not). In principle, the advanced
	version of \gosam\ also allows for the evaluation of two-loop virtual
	matrix elements, however, this is currently not supported in
	\whizard. This method is invoked via the command
	\begin{code}
	$method = "gosam"
	\end{code}
	Of course, this will only work correctly of \gosam\ with all its
	subcomponents has been correctly found during configuration of
	\whizard\ and then subsequently correctly linked.

	In order to generate the tables for spin, flavor and color states for
	the corresponding process, first \oMega\ is called to provide
	\fortran\ code for the interfaces to all the metadata for the
	process(es) to be evaluated. Next, the \gosam\ \python\ script is
	automatically invoked that first checks for the necessary ingredients
	to produce, compile and link the \gosam\ matrix elements. These are
	the the \ttt{Qgraf} topology generator for the diagrams, \ttt{Form} to
	perform algebra, the \ttt{Samurai}, \ttt{AVHLoop}, \ttt{QCDLoop} and
	\ttt{Ninja} libraries for Passarino-Veltman reduction, one-loop tensor
	integrals etc. As a next step, \gosam\ automatically writes and
	executes a \ttt{configure} script, and then it exchanges the Binoth
	Les Houches accord (BLHA) contract files between \whizard\ and
	itself~\cite{Binoth:2010xt,Alioli:2013nda} to check whether it
	actually generate code for the demanded process at the given
	order. Note that the contract and answer files do not have to be
	written by the user by hand, but are generated automatically within
	the program work flow initiated by the original
	\sindarin\ script. \gosam\ then generates \fortran\ code for the
	different components of the processes, compiles it and links it into a
	library, which is then automatically accessible (as an external
	process library) from inside \whizard. The phase space setup and the
	integration as well as the LO (and NLO) event generation work then in
	exactly the same way as for \oMega\ matrix elements.

	As an NLO calculation consists of different components for the Born,
	the real correction, the virtual correction, the subtraction part and
	possible further components depending on the details of the
	calculation, there is the possible to separately choose the matrix
	element method for those components via the keywords
	\ttt{\$loop\_me\_method}, \ttt{\$real\_tree\_me\_method},
	\ttt{\$correlation\_me\_method} etc. These
	keywords overwrite the master switch of the \ttt{\$method} keyword.

	For more information on the switches and details of the functionality
	of \gosam, cf. \url{http://gosam.hepforge.org}.

	%%%%%

	\section{Interface to Openloops}
	\label{sec:openloops_me}

	Very similar to the case of \gosam, cf. Sec.~\ref{sec:gosam_me}, is
	the case for \openloops\ matrix elements. Also here, first \oMega\ is
	called in order to provide an interface for the spin, flavor and color
	degrees of freedom for the corresponding process. Information exchange
	between \whizard\ and \openloops\ then works in the same automatic way
	as for \gosam\ via the BLHA interface. This matrix element method is
	invoked via
	\begin{code}
	$method = "openloops"
	\end{code}
	This again is the master switch that will tell \whizard\ to use
	\openloops\ for all components, while there are special keywords to
	tailor-make the setup for the different components of an NLO
	calculation (cf. Sec.~\ref{sec:gosam_me}.

	The main difference between \openloops\ and \gosam\ is that for
	\openloops\ there is no process code to be generated, compiled and
	linked for a process, but a precompiled library is called and linked,
	e.g. \ttt{ppllj} for the Drell-Yan process. Of course, this library has
	to be installed on the system, but if that is not the case, the user
	can execute the \openloops\ script in the source directory of
	\openloops\ to download, compile and link the corresponding dynamic
	library. This limits (for the moment) the usage of \openloops\ to
	processes where pre-existint libraries for that specific processes
	have been generated by the \openloops\ authors. A new improved
	generator for general process libraries for \openloops\ will get rid
	of that restriction.

	For more information on the installation, switches and details of the
	functionality of \openloops, cf. \url{http://openloops.hepforge.org}.

	%%%%%

	\section{Interface to Recola}
	\label{sec:recola_me}

	The third one-loop provider (OLP) for external matrix elements that
	is supported by \whizard, is \recola. In contrast to \gosam,
	cf. Sec.~\ref{sec:gosam_me}, and \openloops,
	cf. Sec.~\ref{sec:openloops_me}, \recola\ does not use a BLHA
	interface to exchange information with \whizard, but its own
	tailor-made C interoperable library interface to communicate to the
	Monte Carlo side. \recola\ matrix elements are called for via
	\begin{code}
	$method = "recola"
	\end{code}
	\recola\ uses a highly efficient algorithm to generate process code
	for LO and NLO SM amplitudes in a fully recursive manner. At the
	moment, the setup of the interface within \whizard\ does not allow to
	invoke more than one different process in \recola: this would lead to
	a repeated initialization of the main setup of \recola\ and would
	consequently crash it. It is foreseen in the future to have a
	safeguard mechanism inside \whizard\ in order to guarantee
	initialization of \recola\ only once, but this is not yet
	implemented.

	Further information on the installation, details and parameters of
	\recola\ can be found at \url{http://recola.hepforge.org}.

	%%%%%

	\section{Special applications}
	\label{sec:special_me}

	There are also special applications with combinations of matrix
	elements from different sources for dedicated purposes like e.g. for
	the matched top--anti-top threshold in $e^+e^-$. For this special
	application which depending on the order of the matching takes only
	\oMega\ matrix elements or at NLO combines amplitudes from \oMega\ and
	\openloops, is invoked by the method:
	\begin{code}
	$method = "threshold"
	\end{code}


	\newpage

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{Implemented physics}
	\label{chap:physics}

	%%%%%

	\section{The hard interaction models}

	In this section, we give a brief overview over the different
	incarnations of models for the description of the realm of subatomic
	particles and their interactions inside \whizard. In
	Sec.~\ref{sec:smandfriends}, the Standard Model (SM) itself and
	straightforward extensions and modifications thereof in the gauge,
	fermionic and Higgs sector are described. Then,
	Sec.~\ref{sec:bsmmodels} gives a list and short description of all
	genuine beyond the SM models (BSM) that are currently implemented in
	\whizard\ and its matrix element generator \oMega. Additional models
	beyond that can be integrated and handled via the interfaces to
	external tools like \sarah\ and \FeynRules, or the universal model
	format \UFO, cf. Chap.~\ref{chap:extmodels}.

	%%%%%%%%%%%%%%%

	\subsection{The Standard Model and friends}
	\label{sec:smandfriends}


	%%%%

	\subsection{Beyond the Standard Model}
	\label{sec:bsmmodels}

	\begin{table}
	\begin{center}
	\begin{tabular}{\|l\|l\|l\|}
	\hline
	MODEL TYPE & with CKM matrix & trivial CKM \\
	\hline\hline
	Yukawa test model & \tt{---} & \tt{Test} \\
	\hline
	QED with $e,\mu,\tau,\gamma$ & \tt{---} & \tt{QED} \\
	QCD with $d,u,s,c,b,t,g$ & \tt{---} & \tt{QCD} \\
	Standard Model & \tt{SM\_CKM} & \tt{SM} \\
	SM with anomalous gauge couplings & \tt{SM\_ac\_CKM} &
	\tt{SM\_ac} \\
	SM with $Hgg$, $H\gamma\gamma$, $H\mu\mu$, $He^+e^-$ &
	\tt{SM\_Higgs\_CKM} & \tt{SM\_Higgs} \\
	SM with bosonic dim-6 operators & \tt{---} &
	\tt{SM\_dim6} \\
	SM with charge 4/3 top & \tt{---} &
	\tt{SM\_top} \\
	SM with anomalous top couplings & \tt{---} &
	\tt{SM\_top\_anom} \\
	SM with anomalous Higgs couplings & \tt{---} &
	\tt{SM\_rx}/\tt{NoH\_rx}/\tt{SM\_ul} \\\hline
	SM extensions for $VV$ scattering & \tt{---} &
	\tt{SSC}/\tt{AltH}/\tt{SSC\_2}/\tt{SSC\_AltT} \\\hline
	SM with $Z'$ & \tt{---} & \tt{Zprime} \\
	\hline
	Two-Higgs Doublet Model & \tt{THDM\_CKM} & \tt{THDM} \\ \hline\hline
	MSSM & \tt{MSSM\_CKM} & \tt{MSSM} \\
	\hline
	MSSM with gravitinos & \tt{---} & \tt{MSSM\_Grav} \\
	\hline
	NMSSM & \tt{NMSSM\_CKM} & \tt{NMSSM} \\
	\hline
	extended SUSY models & \tt{---} & \tt{PSSSM} \\
	\hline\hline
	Littlest Higgs & \tt{---} & \tt{Littlest} \\
	\hline
	Littlest Higgs with ungauged $U(1)$ & \tt{---} &
	\tt{Littlest\_Eta} \\
	\hline
	Littlest Higgs with $T$ parity & \tt{---} &
	\tt{Littlest\_Tpar} \\
	\hline
	Simplest Little Higgs (anomaly-free) & \tt{---} &
	\tt{Simplest} \\
	\hline
	Simplest Little Higgs (universal) & \tt{---} &
	\tt{Simplest\_univ} \\
	\hline\hline
	SM with graviton & \tt{---} & \tt{Xdim} \\
	\hline
	UED & \tt{---} & \tt{UED} \\
	\hline
	``SQED'' with gravitino & \tt{---} & \tt{GravTest} \\
	\hline
	Augmentable SM template & \tt{---} & \tt{Template} \\
	\hline
	\end{tabular}
	\end{center}
	\caption{\label{tab:models} List of models available in
	\whizard. There are pure test models or models implemented
	for theoretical investigations, a long list of SM variants
	as well as a large number of BSM models.}
	\end{table}

	\subsubsection{Strongly Interacting Models and Composite Models}

	Higgsless models have been studied extensively before the Higgs boson
	discovery at the LHC Run I in 2012 in order to detect possible
	loopholes in the electroweak Higgs sector discovery potential of this
	collider. The Threesite Higgsless Model is one of the simplest
	incarnations of these models, and was one of the first BSM models
	beyond SUSY and Little Higgs models that have been implemented in
	\whizard~\cite{Speckner:2010zi}. It is also called the Minimal
	Higgsless Model (MHM)~\cite{Chivukula:2006cg} is a minimal
	deconstructed Higgsless model which contains only the first resonance
	in the tower of Kaluza-Klein modes of a Higgsless extra-dimensional
	model. It is a non-renormalizable, effective theory whose
	gauge group is an extension of the SM with an extra $SU(2)$ gauge
	group. The breaking of the extended electroweak gauge symmetry is
	accomplished by a set of nonlinear sigma fields which represent the
	effects of physics at a higher scale and make the theory
	nonrenormalizable. The physical vector boson spectrum contains the
	usual photon, $W^\pm$ and $Z$ bosons as well as a $W'^\pm$ and $Z'$
	boson. Additionally, a new set of heavy fermions are introduced to
	accompany the new gauge group ``site'' which mix to form the physical
	eigenstates. This mixing is controlled by the small mixing parameter
	$\epsilon_L$ which is adjusted to satisfy constraints from precision
	observables, such as the S parameter~\cite{Chivukula:2005xm}.
	Here, additional weak gauge boson production at the LHC was
	one of the focus of the studies with \whizard~\cite{Ohl:2008ri}.


	\subsubsection{Supersymmetric Models}

	\whizard/\oMega\ was the first multi-leg matrix-element/event
	generator to include the full Minimal Supersymmetric Standard Model
	(MSSM), and also the NMSSM. The SUSY implementations in \whizard\ have
	been extensively tested~\cite{Ohl:2002jp,Reuter:2009ex}, and have been
	used for many theoretical and experimental studies (some prime
	examples
	being~\cite{Kalinowski:2008fk,Robens:2008sa,Hagiwara:2005wg}.

	\subsubsection{Little Higgs Models}

	\subsubsection{Inofficial models}

	There have been several models that have been included within the
	\whizard/\oMega\ framework but never found their way into the official
	release series. One famous example is the non-commutative extension of
	the SM, the NCSM. There have been several studies, e.g. simulations on
	the $s$-channel production of a $Z$ boson at the photon collider
	option of the ILC~\cite{Ohl:2004tn}. Also, the production of
	electroweak gauge bosons at the LHC in the framework of the NCSM have
	been studied~\cite{Ohl:2010zf}.


	%%%%%%%%%%%%%%%

	\section{The SUSY Les Houches Accord (SLHA) interface}
	\label{sec:slha}


	To be filled in
	...~\cite{Skands:2003cj,AguilarSaavedra:2005pw,Allanach:2008qq}.

	The neutralino sector deserves special attention. After
	diagonalization of the mass matrix expresssed in terms
	of the gaugino and higgsino eigenstates, the resulting mass
	eigenvalues may be either negative or positive. In this case, two
	procedures can be followed. Either the masses are rendered
	positive and the associated mixing matrix gets purely imaginary
	entries or the masses are kept signed, the mixing matrix in this case
	being real. According to the SLHA agreement, the second option is
	adopted. For a specific eigenvalue, the phase is absorbed into the
	definition of the relevant eigenvector, rendering the mass
	negative. However, \whizard\ has not yet officially tested for
	negative masses. For external SUSY models
	(cf.~Chap.~\ref{chap:extmodels}) this means, that one must be careful
	using a SLHA file with explicit factors of
	the complex unity in the mixing matrix, and on the other hand,
	real and positive masses for the neutralinos. For the hard-coded SUSY
	models, this is completely handled internally. Especially
	Ref.~\cite{Hagiwara:2005wg} discusses the details of the neutralino
	(and chargino) mixing matrix.

	%%%%%%%%%%%%%%%%

	\section{Lepton Collider Beam Spectra}
	\label{sec:beamspectra}

	For the simulation of lepton collider beam spectra there are two
	dedicated tools, \circeone\ and \circetwo\ that have been written as
	in principle independent tools. Both attempt to describe the
	details of electron (and positron) beams in a realistic lepton
	collider environment. Due to the quest for achieving high peak
	luminosities at $e^+e^-$ machines, the goal is to make the spatial
	extension of the beam as small as possible but keeping the area of the
	beam roughly constant. This is achieved by forcing the beams in the
	final focus into the shape of a quasi-2D bunch. Due to the high charge
	density in that bunch, the bunch electron distribution is modified by
	classical electromagnetic radiation, so called {\em beamstrahlung}.
	The two \circe\ packages are intended to perform a simulation of this
	beamstrahlung and its consequences on the electron beam spectrum as
	realistic as possible. More details about the two packages can be
	found in their stand-alone documentations. We will discuss the basic
	features of lepton-collider beam simulations in the next two sections,
	including the technicalities of passing simulations of the machine
	beam setup to \whizard. This will be followed by a section on the
	simulation of photon collider spectra, included for historical
	reasons.

	%%%%%

	\subsection{\circeone}

	While the bunches in a linear collider cross only once, due to their
	small size they experience a strong beam-beam effect. There is a
	code to simulate the impact of this effect on luminosity and
	background, called
	\ttt{GuineaPig++}~\cite{Schulte:1998au,Schulte:1999tx,Schulte:2007zz}.
	This takes into account the details of the accelerator, the final
	focus etc. on the structure of the beam and the main features of the
	resulting energy spectrum of the electrons and positrons. It offers
	the state-of-the-art simulation of lepton-collider beam spectra as
	close as possible to reality. However, for many high-luminosity
	simulations, event files produced with \ttt{GuineaPig++} are usually
	too small, in the sense that not enough independent events are
	available for physics simulations. Lepton collider beam spectra do
	peak at the nominal beam energy ($\sqrt{s}/2$) of the collider, and
	feature very steeply falling tails. Such steeply falling distributions
	are very poorly mapped by histogrammed distributions with fixed bin
	widths.

	The main working assumption to handle such spectra are being followed
	within \circeone:
	\begin{enumerate}
	\label{circe1_assumptions}
	\item The beam spectra for the two beams $P_1$ and $P_2$ factorize
	(here $x_1$ and $x_2$ are the energy fractions of the two beams,
	respectively):
	\begin{equation*}
	D_{P_1P_2} (x_1, x_2) = D_{P_1} (x_1) \cdot D_{P_2} (x_2)
	\end{equation*}

	\item
	The peak is described with a delta distribution, and the tail with a
	power law:
	\begin{equation*}
	D(x) = d \cdot \delta(1-x) \; + \; c \cdot x^\alpha \, (1-x)^\beta
	\end{equation*}
	\end{enumerate}
	The two powers $\alpha$ and $\beta$ are the main coefficients that can
	be tuned in order to describe the spectrum with \circeone\ as close as
	possible as the original \ttt{GuineaPig++} spectrum. More details
	about how \circeone\ works and what it does can be found in its own
	write-up in \ttt{circe1/share/doc}.

	\subsection{\circetwo}

	The two conditions listed in \ref{circe1_assumptions} are too
	restrictive and hence insufficient to describe more complicated
	lepton-collider beam spectra, as they e.g. occur in the CLIC
	drive-beam design. Here, the two beams are highly correlated and also
	a power-law description does not give good enough precision for the
	tails. To deal with these problems, \circetwo\ starts with a
	two-dimensional histogram featuring factorized, but variable bin
	widths in order to simulate the steep parts of the
	distributions. The limited statistics from too small
	\ttt{GuineaPig++} event output files leads to correlated
	fluctuations that would leave strange artifacts in the
	distributions. To abandon them, Gaussian filters are applied to smooth
	out the correlated fluctuations. Here care has to be taken when going
	from the continuum in $x$ momentum fraction space to the corresponding
	\begin{figure}
	\centering
	\includegraphics{circe2-smoothing}
	\caption{\label{fig:circe2-smoothing}
	Smoothing the bin at the $x_{e^+} = 1$ boundary with Gaussian
	filters of 3 and 10 bins width compared to no smoothing.}
	\end{figure}
	boundaries: separate smoothing procedures are being applied to the
	bins in the continuum region and those in the boundary in order to
	avoid artificial unphysical beam energy
	spreads. Fig.~\ref{fig:circe2-smoothing} shows the smoothing of the
	distribution for the bin at the $x_{e^+} = 1$ boundary. The blue dots
	show the direct \ttt{GuineaPig++} output comprising the
	fluctuations due to the low statistics. Gaussian filters with widths
	of 3 and 10 bins, respectively, have been applied (orange and green
	dots, resp.). While there is still considerable fluctuation for 3 bin
	width Gaussian filtering, the distribution is perfectly smooth for 10
	bin width. Hence, five bin widths seem a reasonable compromise for
	histograms with a total of 100 bins. Note that the bins are not
	equidistant, but shrink with a power law towards the $x_{e^-} = 1$
	boundary on the right hand side of Fig.~\ref{fig:circe2-smoothing}.

	\whizard\ ships (inside its subpackage \circetwo) with prepared beam
	spectra ready to be used within \circetwo\ for the ILC beam spectra
	used in the ILC
	TDR~\cite{Behnke:2013xla,Baer:2013cma,Adolphsen:2013jya,Adolphsen:2013kya,Behnke:2013lya}. These
	comprise the designed staging energies of 200 GeV, 230 GeV, 250 GeV,
	350 GeV, and 500 GeV. Note that all of these spectra up to now do not
	take polarization of the original beams on the beamstrahlung into
	account, but are polarization-averaged. For backwards compatibility,
	also the 500 GeV spectra for the TESLA
	design~\cite{AguilarSaavedra:2001rg,Richard:2001qm}, here both for
	polarized and polarization-averaged cases, are included. Correlated
	spectra for CLIC staging energies like 350 GeV, 1400 GeV and 3000 GeV
	are not yet (as of version 2.2.4) included in the \whizard\
	distribution.

	In the following we describe how to obtain such files with the tools
	included in \whizard (resp. \circetwo). The procedure is equivalent to
	the so-called \ttt{lumi-linker} construction used by Timothy
	Barklow (SLAC) together with the legacy version \whizard\ttt{ 1.95}.
	The workflow to produce such files is to run \ttt{GuineaPig++} with
	the following input parameters:
	\begin{Code}
	do_lumi = 7;
	num_lumi = 100000000;
	num_lumi_eg = 100000000;
	num_lumi_gg = 100000000;
	\end{Code}
	This demands from \ttt{GuineaPig++} the generation of distributions
	for the $e^-e^+$, $e^\mp \gamma$, and $\gamma\gamma$ components of the
	beamstrahlung's spectrum, respectively. These are the files
	\ttt{lumi.ee.out}, \ttt{lumi.eg.out}, \ttt{lumi.ge.out}, and
	\ttt{lumi.gg.out}, respectively. These contain pairs $(E_1, E_2)$
	of beam energies, {\em not} fractions of the original beam
	energy. Huge event numbers are out in here, as \ttt{GuineaPig++}
	will produce only a small fraction due to a very low generation
	efficiency.

	The next step is to transfer these output files from
	\ttt{GuineaPig++} into input files used with \circetwo. This is
	done by means of the tool \ttt{circe\_tool.opt} that is installed
	together with the \whizard\ main binary and libraries. The user should
	run this executable with the following input file:
	\begin{Code}
	{ file="ilc500/ilc500.circe" # to be loaded by WHIZARD
	{ design="ILC" roots=500 bins=100 scale=250 # E in [0,1]
	{ pid/1=electron pid/2=positron pol=0 # unpolarized e-/e+
	events="ilc500/lumi.ee.out" columns=2 # <= Guinea-Pig
	lumi = 1564.763360 # <= Guinea-Pig
	iterations = 10 # adapting bins
	smooth = 5 [0,1) [0,1) # Gaussian filter 5 bins
	smooth = 5 [1] [0,1) smooth = 5 [0,1) [1] } } }
	\end{Code}
	The first line defines the output file, that later can be read in into
	the beamstrahlung's description of \whizard\ (cf. below). Then, in the
	second line the design of the collider (here: ILC for 500 GeV
	center-of-mass energy, with the number of bins) is specified. The next
	line tells the tool to take the unpolarized case, then the
	\ttt{GuineaPig++} parameters (event file and luminosity) are
	set. In the last three lines, details concerning the adaptation of the
	simulation as well as the smoothing procedure are being specified: the
	number of iterations in the adaptation procedure, and for the
	smoothing with the Gaussian filter first in the continuum and then at
	the two edges of the spectrum. For more details confer the
	documentation in the \circetwo\ subpackage.

	This produces the corresponding input files that can be used within
	\whizard\ to describe beamstrahlung for lepton colliders, using a
	\sindarin\ input file like:
	\begin{Code}
	beams = e1, E1 => circe2
	$circe2_file = "ilc500.circe"
	$circe2_design = "ILC"
	?circe2_polarized = false
	\end{Code}


	%%%%%

	\subsection{Photon Collider Spectra}

	For details confer the complete write-up of the \circetwo\
	subpackage.

	%%%%%

	\section{Transverse momentum for ISR photons}
	\label{sec:isr-photon-handler}

	The structure functions that describe the splitting of a beam particle
	into a particle pair, of which one enters the hard interaction and the
	other one is radiated, are defined and evaluated in the strict
	collinear approximation. In particular, this holds for the ISR
	structure function which describes the radiation of photons off a
	charged particle in the initial state.

	The ISR structure function that is used by \whizard\ is understood to
	be inclusive, i.e., it implicitly contains an integration over
	transverse momentum. This approach is to be used for computing a
	total cross section via \ttt{integrate}. In \whizard, it is possible
	to unfold this integration, as a transformation that is applied by
	\ttt{simulate} step, event by event. The resulting modified events
	will show a proper logarithmic momentum-transfer ($Q^2$) distribution
	for the radiated photons. The recoil is applied to the
	hard-interaction system, such that four-momentum and $\sqrt{\hat s}$
	are conserved. The distribution is cut off by $Q_{\text{max}}^2$
	(cf. \ttt{isr\_q\_max}) for large momentum transfer, and smoothly by
	the parton mass (cf.\ \ttt{isr\_mass}) for small momentum transfer.

	To activate this modification, set
	\begin{Code}
	?isr_handler = true
	$isr_handler_mode = "recoil"
	\end{Code}
	before, or as an option to, the \ttt{simulate} command.

	Limitations: the current implementation of the $p_T$ modification
	works only for the symmetric double-ISR case, i.e., both beams have to
	be charged particles with identical mass (e.g., $e^+e^-$). The mode
	\ttt{recoil} generates exactly one photon per beam, i.e., it modifies
	the momentum of the single collinear photon that the ISR structure
	function implementation produces, for each beam. (It is foreseen that
	further modes or options will allow to generate multiple photons.
	Alternatively, the \pythia\ shower can be used to simulate multiple
	photons radiated from the initial state.)

	%%%%%

	\section{Transverse momentum for the EPA approximation}
	\label{sec:epa-beam-handler}

	For the equivalent-photon approximation (EPA), which is also defined
	in the collinear limit, recoil momentum can be inserted into generated
	events in an entirely analogous way. The appropriate settings are
	\begin{Code}
	?epa_handler = true
	$epa_handler_mode = "recoil"
	\end{Code}

	Limitations: as for ISR, the current implementation of the $p_T$
	modification works only for the symmetric double-EPA case. Both
	incoming particles of the hard process must be photons, while both
	beams must be charged particles with identical mass (e.g., $e^+e^-$).
	Furthermore, the current implementation does not respect the
	kinematical limit parameter \verb\|epa_q_min\|, it has to be set to
	zero. In effect, the lower $Q^2$ cutoff is determined by the
	beam-particle mass \verb\|epa_mass\|, and the upper cutoff is either
	given by $Q_{\text{max}}$ (the parameter
	\verb\|epa_q_max\|), or by the limit $\sqrt{s}$ if this is not set.

	It is possible to combine the ISR and EPA handlers, for processes
	where ISR is active for one of the beams, EPA for the other beam. For
	this scenario to work, both handler switches must be on, and both mode
	strings must coincide. The parameters are set separately for ISR and
	EPA, as described above.

	%%%%%

	\section{Resonances and continuum}

	\subsection{Complete matrix elements}

	Many elementary physical processes are composed of contributions that can be
	qualified as (multiply) \emph{resonant} or \emph{continuum}. For instance,
	the amplitude for the process $e^+e^-\to q\bar q q\bar q$, evaluated at tree
	level in perturbation theory, contains Feynman diagrams with zero, one, or two
	$W$ and $Z$ bosons as virtual lines. If the kinematical constraints allow
	this, two vector bosons can become simultaneously on-shell in part of phase
	space. To a first approximation, this situation is understood as $W^+W^-$ or
	$ZZ$ production with subsequent decay. The kinematical distributions show
	distinct resonances in the quark-pair spectra. Other graphs contain only one
	s-channel $W/Z$ boson, or none at all, such as graphs with $q\bar q$
	production and subsequent gluon radiation, splitting into another $q\bar q$
	pair.

	A \whizard\ declaration of the form
	\begin{Code}
	process q4 = e1, E1 => u, U, d, D
	\end{Code}
	produces the full set of graphs for the selected final state, which after
	squaring and integrating yields the exact tree-level result for the process.
	The result contains all doubly and singly resonant parts, with correct
	resonance shapes, as well as the continuum contribution and all interference.
	This is, to given order in perturbation theory, the best possible
	approximation to the true result.

	\subsection{Processes restricted to resonances}

	For an intuitive separation of a two-boson ``signal'' contribution, it is
	possible to restrict the set of graphs to a certain intermediate state. For
	instance, the declaration
	\begin{Code}
	process q4_zz = e1, E1 => u, U, d, D { $restrictions = "3+4~Z && 5+6~Z" }
	\end{Code}
	generates an amplitude that contains only those Feynman graphs where the
	specified quarks are connected to a $Z$ virtual line. The result may be
	understood as $ZZ$ production with subsequent decay, where the $Z$ resonances
	exhibit a Breit-Wigner shape. Combining this with the
	analogous $W^+W^-$ restricted process, the user can generate ``signal''
	processes.

	Adding both ``signal'' cross sections $WW$ and $ZZ$ will result in a
	reasonable approximation to the exact tree-level cross section. The amplitude
	misses the single-resonant and continuum contributions, and the squared
	amplitude misses the interference terms, however. More importantly, the
	restricted processes as such are not gauge-invariant (with respect to the
	electroweak gauge group), and they are no longer dominant away from resonant
	kinematics. We therefore strongly recommend that such restricted processes
	are always accompanied by a cut setup that restricts the kinematics to an
	approximately on-shell pattern for both resonances. For instance:
	\begin{Code}
	cuts = all 85 GeV < M < 95 GeV [u:U]
	and all 85 GeV < M < 95 GeV [d:D]
	\end{Code}
	In this region, the gauge-dependent and continuum contributions are strictly
	subdominant. Away from the resonance(s), the results for a restricted process
	are meaningless, and the full process has to be computed instead.

	\subsection{Factorized processes}

	Another method for obtaining the signal contribution is a proper factorization
	into resonance production and decay. We would have to generate a production
	process and two decay processes:
	\begin{Code}
	process z_uu = Z => u, U
	process z_dd = Z => d, D
	process zz = e1, E1 => Z, Z
	\end{Code}
	All three processes must be integrated. The integration results are partial
	decay widths and the $ZZ$ production cross section, respectively. (Note that
	cut expressions in \sindarin\ apply to all integrations, so make sure that
	no production-process cuts are active when integrating the decay
	processes.)

	During a later event-generation step, the $Z$ decays can then be activated by declaring the $Z$ as
	unstable,
	\begin{Code}
	unstable Z (z_uu, z_dd)
	\end{Code}
	and then simulating the production process
	\begin{Code}
	simulate (zz)
	\end{Code}
	The generated events will consist of four-fermion final states, including all
	combinations of both decay modes. It is important to note that in this setup,
	the invariant $u\bar u$ and $d\bar d$ masses will be always \emph{exactly}
	equal to the $Z$ mass. There is no Breit-Wigner shape involved. However, in
	this approximation the results are gauge-invariant, as there is no off-shell
	contribution involved.

	For further details on factorized processes and spin correlations,
	cf.\ Sec.~\ref{sec:spin-correlations}.


	\subsection{Resonance insertion in the event record}

	From the above discussion, we may conclude that it is always preferable to
	compute the complete process for a given final state, as long as this is
	computationally feasible. However, in the simulation step this approach also
	has a drawback. Namely, if a parton-shower module (see below) is switched on,
	the parton-shower algorithm relies on event details in order to determine the
	radiation pattern of gluons and further splitting. In the generated event
	records, the full-process events carry the signature of non-resonant continuum
	production with no intermediate resonances. The parton shower will thus start
	the evolution at the process energy scale, the total available energy. By
	contrast, for an electroweak production and decay process, the evolution
	should start only at the vector boson mass, $m_Z$. In effect, even though the
	resonant contribution of $WW$ and $ZZ$ constitutes the bulk of the cross
	section, the radiation pattern follows the dynamics of four-quark continuum
	production. In general, the number of radiated hadrons will be too high.


	\begin{figure}
	\begin{center}
	\includegraphics[width=.41\textwidth]{resonance_e_gam}
	\includegraphics[width=.41\textwidth]{resonance_n_charged} \\
	\includegraphics[width=.41\textwidth]{resonance_n_hadron}
	\includegraphics[width=.41\textwidth]{resonance_n_particles} \\
	\includegraphics[width=.41\textwidth]{resonance_n_photons}
	\includegraphics[width=.41\textwidth]{resonance_n_visible}
	\end{center}
	\caption{The process $e^+e^- \to jjjj$ at 250 GeV center-of-mass
	energy is compared transferring the partonic events naively to the
	parton shower, i.e. without respecting any intermediate resonances
	(red lines). The blue lines show the process factorized into $WW$
	production and decay, where the shower knows the origin of the two
	jet pairs. The orange and dark green lines show the resonance
	treatment as mentioned in the text, with
	\ttt{resonance\_on\_shell\_limit = 1} and \ttt{= 4},
	respectively. \pythiasix\ parton shower and hadronization with the
	OPAL tune have been used. The observables are: photon energy
	distribution and number of charged tracks (upper line left/right,
	number of hadrons and total number of particles (middle
	left/right), and number of photons and neutral particles (lower
	line left/right).}
	\end{figure}

	To overcome this problem, there is a refinement of the process description
	available in \whizard. By modifying the process declaration to
	\begin{Code}
	?resonance_history = true
	resonance_on_shell_limit = 4
	process q4 = e1, E1 => u, U, d, D
	\end{Code}
	we advise the program to produce not just the complete matrix element, but
	also all possible restricted matrix elements containing resonant intermediate
	states. This has no effect at all on the integration step, and thus on the
	total cross section.

	However, when subsequently events are generated with this setting, the program
	checks, for each event, the kinematics and determines the set of potentially
	resonant contributions. The criterion is whether the off-shellness of a
	particular would-be resonance is less than the resonance width multiplied by
	the value of \verb\|resonance_on_shell_limit\| (default value $=4$). For the
	set of resonance histories which pass this criterion (which can be empty),
	their respective squared matrix element is related to the full-process matrix
	element. The ratio is interpreted as a probability. The random-number
	generator then selects one or none of the resonance histories, and modifies
	the event record accordingly. In effect, for an appropriate fraction of the
	events, depending on the kinematics, the parton-shower module is provided with
	resonance information, so it can adjust the radiation pattern accordingly.

	It has to be mentioned that generating the matrix-element code for all
	possible resonance histories takes additional computing resources. In the
	current default setup, this feature is switched off. It has to be explicitly
	activated via the \verb\|?resonance_history\| flag.

	Also, the feature can be activated or deactivated individually for
	each process, such as in
	\begin{Code}
	?resonance_history = true
	process q4_with_res = e1, E1 => u, U, d, D { ?resonance_history = true }
	process q4_wo_res = e1, E1 => u, U, d, D { ?resonance_history = false }
	\end{Code}
	If the flag is \verb\|false\| for a process, no resonance code will be
	generated. Similarly, the flag has to be globally or locally active
	when \verb\|simulate\| is called, such that the feature takes effect for
	event generation.

	There are two additional parameters that can fine-tune the conditions for
	resonance insertion in the event record. Firstly, the parameter
	\verb\|resonance_on_shell_turnoff\|, if nonzero, enables a Gaussian suppression
	of the probability for resonance insertion. For instance, setting
	\begin{Code}
	?resonance_history = true
	resonance_on_shell_turnoff = 4
	resonance_on_shell_limit = 8
	\end{Code}
	will reduce the probability for the event to be qualified as resonant by
	$e^{-1}= 37\,\%$ if the kinematics is off-shell by four units of the width,
	and by $e^{-4}=2\,\%$ at eight units of the width. Beyond this point, the
	setting of the \verb\|resonance_on_shell_limit\| parameter eliminates resonance
	insertion altogether. In effect, the resonance-background transition is
	realized in a smooth way. Secondly, within the resonant-kinematics range the
	probability for qualifying the event as background can be reduced by the
	parameter \verb\|resonance_background_factor\| (default value $=1$) to a number
	between zero and one. Setting this to zero means that the event will be
	necessarily qualified as resonant, if it falls within the resonant-kinematics
	range.

	Note that if an event, by the above mechanism, is identified as following a
	certain resonance history, the assigned color flow will be chosen to match the
	resonance history, not the complete matrix element. This may result in a
	reassignment of color flow with respect to the original partonic event.

	Finally, we mention the order of execution: any additional
	matrix element code is compiled and linked when \verb\|compile\| is
	executed for the processes in question. If this command is omitted,
	the \verb\|simulate\| command will trigger compilation.


	\section{Parton showers and Hadronization}

	In order to produce sensible events, final state QCD (and also QED)
	radiation has to be considered as well as the binding of strongly
	interacting partons into mesons and baryons. Furthermore, final state
	hadronic resonances undergo subsequent decays into those particles
	showing up in (or traversing) the detector. The latter are mostly
	pions, kaons, photons, electrons and muons.

	The physics associated with these topics can be divided into the
	perturbative part which is the regime of the parton shower, and the
	non-perturbative part which is the regime for the
	hadronization. \whizard\ comes with its own two different parton
	shower implementations, an analytic and a so-called $k_T$-ordered
	parton shower that will be detailed in the next section.

	Note that in general it is not advisable to use different shower and
	hadronization methods, or in other words, when using shower and
	hadronization methods from different programs these would have to be
	tuned together again with the corresponding data.

	Parton showers are approximations to full matrix elements taking only
	the leading color flow into account, and neglecting all interferences
	between different amplitudes leading to the same exclusive final
	state. They rely on the QCD (and QED) splitting functions to describe
	the emissions of partons off other partons. This is encoded in the
	so-called Sudakov form factor~\cite{Sudakov:1954sw}:
	\begin{equation*}
	\Delta( t_1, t_2) = \exp \left[ \int\limits_{t_1}^{t_2} \mbox{d} t
	\int\limits_{z_-}^{z_+} \mbox{d} z \frac{\alpha_s}{2 \pi t} P(z)
	\right]
	\end{equation*}
	This gives the probability for a parton to evolve from scale $t_2$ to
	$t_1$ without any further emissions of partons. $t$ is the evolution
	parameter of the shower, which can be a parton energy, an emission
	angle, a virtuality, a transverse momentum etc. The variable $z$
	relates the two partons after the branching, with the most common
	choice being the ratio of energies of the parton after and before the
	branching. For final-state radiation brachings occur after the hard
	interaction, the evolution of the shower starts at the scale of the
	hard interaction, $t \sim \hat{s}$, down to a cut-off scale $t =
	t_{\text{cut}}$ that marks the transition to the non-perturbative
	regime of hadronization. In the space-like evolution for the
	initial-state shower, the evolution is from a cut-off representing the
	factorization scale for the parton distribution functions (PDFs) to the
	inverse of the hard process scale, $-\hat{s}$. Technically, this
	evolution is then backwards in (shower) time~\cite{Sjostrand:1985xi},
	leading to the necessity to include the PDFs in the Sudakov factors.

	The main switches for the shower and hadronization which are realized
	as transformations on the partonic events within \whizard\ are
	\ttt{?allow\_shower} and \ttt{?allow\_hadronization}, which are
	true by default and only there for technical reasons. Next, different
	shower and hadronization methods can be chosen within \whizard:
	\begin{code}
	$shower_method = "WHIZARD"
	$hadronization_method = "PYTHIA6"
	\end{code}
	The snippet above shows the default choices in \whizard\, namely
	\whizard's intrinsic parton shower, but \pythiasix\ as hadronization
	tool. (Note that \whizard\ does not have its own hadronization module
	yet.) The usage of \pythiasix\ for showering and hadronization will
	be explained in Sec.~\ref{sec:pythia6}, while the two different
	implementations of the \whizard\ homebrew parton showers are discussed
	in Sec.~\ref{sec:ktordered} and~\ref{sec:analytic}, respectively.

	%%%%%

	\subsection{The $k_T$-ordered parton shower}
	\label{sec:ktordered}

	%%%%%

	\subsection{The analytic parton shower}
	\label{sec:analytic}

	%%%%%

	\subsection{Parton shower and hadronization from \pythiasix}
	\label{sec:pythia6}

	Development of the \pythiasix\ generator for parton shower and
	hadronization (the \fortran\ version) has been discontinued by the
	authors several years ago. Hence, the final release of that program is
	frozen. This allowed to ship this final version, v6.427, with the
	\whizard\ distribution without the need of updating it all the
	time. One of the main reasons for that inclusion -- besides having the
	standard tool for showering and hadronization for decays at hand -- is
	to allow for backwards validation within \whizard\ particularly for
	the event samples generated for the development of linear collider
	physics: first for TESLA, JLC and NLC, and later on for the Conceptual
	and Technical Design Report for ILC, for the Conceptual Design Report
	for CLIC as well as for the Letters of Intent for the LC detectors,
	ILD and SiD.

	Usually, an external parton shower and hadronization program (PS) is
	steered via the transfer of event files that are given to the PS via
	LHE events, while the PS program then produces hadron level events,
	usually in HepMC format. These can then be directed towards a full or
	fast detector simulation program. As \pythiasix\ has been completely
	integrated inside the \whizard\ framework, the showered or more
	general hadron level events can be returned to and kept inside
	\whizard's internal event record, and hence be used in \whizard's
	internal event analysis. In that way, the events can be also written
	out in event formats that are not supported by \pythiasix,
	e.g. \ttt{LCIO} via the output capabilities of \whizard.

	There are several switches to directly steer \pythiasix\ (the values
	in brackets correspond to the \pythiasix\ variables):
	\begin{code}
	ps_mass_cutoff = 1 GeV [PARJ(82)]
	ps_fsr_lambda = 0.29 GeV [PARP(72)]
	ps_isr_lambda = 0.29 GeV [PARP(61)]
	ps_max_n_flavors = 5 [MSTJ(45)]
	?ps_isr_alphas_running = true [MSTP(64)]
	?ps_fsr_alphas_running = true [MSTJ(44)]
	ps_fixed_alphas = 0.2 [PARU(111)]
	?ps_isr_angular_ordered = true [MSTP(62)]
	ps_isr_primordial_kt_width = 1.5 GeV [PARP(91)]
	ps_isr_primordial_kt_cutoff = 5.0 GeV [PARP(93)]
	ps_isr_z_cutoff = 0.999 [1-PARP(66)]
	ps_isr_minenergy = 2 GeV [PARP(65)]
	?ps_isr_only_onshell_emitted_partons =
	true [MSTP(63)]
	\end{code}
	The values given above are the default values. The first value
	corresponds to the \pythiasix\ parameter \ttt{PARJ(82)}, its
	squared being the minimal virtuality that is allowed for the parton
	shower, i.e. the cross-over to the hadronization. The same parameter
	is used also for the \whizard\ showers. \ttt{ps\_fsr\_lambda} is
	the equivalent of \ttt{PARP(72)} and is the $\Lambda_{\text{QCD}}$
	for the final state shower. The corresponding variable for the initial
	state shower is called \ttt{PARP(61)} in \pythiasix. By the next
	variable (\ttt{MSTJ(45)}), the maximal number of flavors produced
	in splittings in the shower is given, together with the number of
	active flavors in the running of
	$\alpha_s$. \ttt{?ps\_isr\_alphas\_running} which corresponds to
	\ttt{MSTP(64)} in \pythiasix\ determines whether or net a running
	$\alpha_s$ is taken in the space-like initial state showers. The same
	variable for the final state shower is \ttt{MSTJ(44)}. For fixed
	$\alpha_s$, the default value is given by \ttt{ps\_fixed\_alpha},
	corresponding to \ttt{PARU(111)}. \ttt{MSTP(62)} determines
	whether the ISR shower is angular order, i.e. whether angles are
	increasing towards the hard interaction. This is per default true, and
	set in the variable \ttt{?ps\_isr\_angular\_ordered}. The width of
	the distribution for the primordial (intrinsic) $k_T$ distribution
	(which is a non-perturbative quantity) is the \pythiasix\ variable
	\ttt{PARP(91)}, while in \whizard\ it is given by
	\ttt{pythia\_isr\_primordial\_kt\_width}. The next variable
	(\ttt{PARP(93}) gives the upper cutoff for that distribution, which
	is 5 GeV per default. For splitting in space-like showers, there is a
	cutoff on the $z$ variable named \ttt{ps\_isr\_z\_cutoff} in
	\whizard. This corresponds to one minus the value of the
	\pythiasix\ parameter \ttt{PARP(66)}. \ttt{PARP(65)}, on the
	other hand, gives the minimal (effective) energy for a time-like or
	on-shell emitted parton on a space-like QCD shower, given by the
	\sindarin\ parameter \ttt{ps\_isr\_minenergy}. Whether or not
	partons emitted from space-like showers are allowed to be only
	on-shell is given by
	\ttt{?ps\_isr\_only\_onshell\_emitted\_partons}, \ttt{MSTP(63)}
	in \pythiasix\ language.
	For more details confer the
	\pythiasix\ manual~\cite{Sjostrand:2006za}.

	Any other non-standard \pythiasix\ parameter can be fed into the
	parton shower via the string variable
	\begin{code}
	$ps_PYTHIA_PYGIVE = "...."
	\end{code}
	Variables set here get preference over the ones set explicitly by
	dedicated \sindarin\ commands. For example, the OPAL tune for hadronic
	final states can be set via:
	\begin{code}
	$ps_PYTHIA_PYGIVE = "MSTJ(28)=0; PMAS(25,1)=120.; PMAS(25,2)=0.3605E-02; MSTJ(41)=2;
	MSTU(22)=2000; PARJ(21)=0.40000; PARJ(41)=0.11000; PARJ(42)=0.52000; PARJ(81)=0.25000;
	PARJ(82)=1.90000; MSTJ(11)=3; PARJ(54)=-0.03100; PARJ(55)=-0.00200; PARJ(1)=0.08500;
	PARJ(3)=0.45000; PARJ(4)=0.02500; PARJ(2)=0.31000; PARJ(11)=0.60000; PARJ(12)=0.40000;
	PARJ(13)=0.72000; PARJ(14)=0.43000; PARJ(15)=0.08000; PARJ(16)=0.08000;
	PARJ(17)=0.17000; MSTP(3)=1;MSTP(71)=1"
	\end{code}

	\vspace{0.5cm}

	A very common error that appears quite often when using
	\pythiasix\ for SUSY or any other model having a stable particle that
	serves as a possible Dark Matter candidate, is the following
	warning/error message:
	\begin{Code}
	Advisory warning type 3 given after 0 PYEXEC calls:
	(PYRESD:) Failed to decay particle 1000022 with mass 15.000
	******************************************************************************
	******************************************************************************
	*** FATAL ERROR: Simulation: failed to generate valid event after 10000 tries
	******************************************************************************
	******************************************************************************
	\end{Code}
	In that case, \pythiasix\ gets a stable particle (here the lightest
	neutralino with the PDG code 1000022) handed over and does not know
	what to do with it. Particularly, it wants to treat it as a heavy
	resonance which should be decayed, but does not know how do
	that. After a certain number of tries (in the example abobe 10k),
	\whizard\ ends with a fatal error telling the user that the event
	transformation for the parton shower in the simulation has failed
	without producing a valid event. The solution to work around that
	problem is to let \pythiasix\ know that the neutralino (or any other
	DM candidate) is stable by means of
	\begin{code}
	$ps_PYTHIA_PYGIVE = "MDCY(C1000022,1)=0"
	\end{code}
	Here, 1000022 has to be replaced by the stable dark matter candidate
	or long-lived particle in the user's favorite model. Also note that
	with other options being passed to \pythiasix\, the \ttt{MDCY}
	option above has to be added to an existing
	\ttt{\$ps\_PYTHIA\_PYGIVE} command separated by a semicolon.

	%%%%%

	\subsection{Parton shower and hadronization from \pythiaeight}

	\subsection{Other tools for parton shower and hadronization}

	\subsection{Loop-induced processes}

	In order to steer loop-induced processes the usage of the OLP
	\openloops is required. Information on the interface and setting up
	this program can be found in Sec.~\ref{sec:openloops_me} and
	Sec.~\ref{sec:openloops-setup}. Furthermore the following settings should
	be observed
	\begin{itemize}
	\item Choose the model \ttt{SM\_Higgs} to allow vertices such as $gg \to H$.
	\item Use \ttt{\$method="openloops"} for the loop-squared amplitudes.
	\item Set the coupling powers \ttt{alpha\_power} and \ttt{alphas\_power}
	corresponding to those of loop-squared amplitudes of the process.
	\end{itemize}

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{More on Event Generation}
	\label{chap:events}

	In order to perform a physics analysis with \whizard\ one has to
	generate events. This seems to be a trivial statement, but as there
	have been any questions like "My \whizard\ does not produce plots --
	what has gone wrong?" we believe that repeating that rule is
	worthwile. Of course, it is not mandatory to use \whizard's own analysis
	set-up, the user can always choose to just generate events and use
	his/her own analysis package like \ttt{ROOT}, or \ttt{TopDrawer}, or
	you name it for the analysis.

	Accordingly, we first start to describe how to generate events and
	what options there are -- different event formats, renaming output
	files, using weighted or unweighted events with different
	normalizations. How to re-use and manipulate already generated event
	samples, how to limit the number of events per file, etc. etc.

	\section{Event generation}

	To explain how event generation works, we again take our favourite
	example, $e^+e^- \to \mu^+ \mu^-$,
	\begin{verbatim}
	process eemm = e1, E1 => e2, E2
	\end{verbatim}
	The command to trigger generation of events is \ttt{simulate
	(<proc\_name>) \{ <options> \}}, so in our case -- neglecting any
	options for now -- simply:
	\begin{verbatim}
	simulate (eemm)
	\end{verbatim}
	When you run this \sindarin\ file you will experience a fatal error:
	\ttt{FATAL ERROR: Colliding beams: sqrts is zero (please set
	sqrts)}. This is because \whizard\ needs to compile and integrate the
	process \ttt{eemm} first before event simulation, because it needs the
	information of the corresponding cross section, phase space
	parameterization and grids. It does both automatically, but you have
	to provide \whizard\ with the beam setup, or at least with the
	center-of-momentum energy. A corresponding \ttt{integrate} command
	like
	\begin{verbatim}
	sqrts = 500 GeV
	integrate (eemm) { iterations = 3:10000 }
	\end{verbatim}
	obviously has to appear {\em before} the corresponding \ttt{simulate}
	command (otherwise you would be punished by the same error message as
	before). Putting things in the correct order results in an output
	like:
	\begin{footnotesize}
	\begin{verbatim}
	\| Reading model file '/usr/local/share/whizard/models/SM.mdl'
	\| Preloaded model: SM
	\| Process library 'default_lib': initialized
	\| Preloaded library: default_lib
	\| Reading commands from file 'bla.sin'
	\| Process library 'default_lib': recorded process 'eemm'
	sqrts = 5.000000000000E+02
	\| Integrate: current process library needs compilation
	\| Process library 'default_lib': compiling ...
	\| Process library 'default_lib': keeping makefile
	\| Process library 'default_lib': keeping driver
	\| Process library 'default_lib': active
	\| Process library 'default_lib': ... success.
	\| Integrate: compilation done
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 29912
	\| Initializing integration for process eemm:
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'eemm'
	\| Library name = 'default_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'eemm_i1': e-, e+ => mu-, mu+ [omega]
	\| ------------------------------------------------------------------------
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e- (mass = 5.1099700E-04 GeV)
	\| e+ (mass = 5.1099700E-04 GeV)
	\| sqrts = 5.000000000000E+02 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'eemm_i1.phs'
	\| Phase space: 2 channels, 2 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| OpenMP: Using 8 threads
	\| Starting integration for process 'eemm'
	\| Integrate: iterations = 3:10000
	\| Integrator: 2 chains, 2 channels, 2 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 10000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 9216 4.2833237E+02 7.14E-02 0.02 0.02* 40.29
	2 9216 4.2829071E+02 7.08E-02 0.02 0.02* 40.29
	3 9216 4.2838304E+02 7.04E-02 0.02 0.02* 40.29
	\|-----------------------------------------------------------------------------\|
	3 27648 4.2833558E+02 4.09E-02 0.01 0.02 40.29 0.43 3
	\|=============================================================================\|
	\| Time estimate for generating 10000 events: 0d:00h:00m:04s
	\| Creating integration history display eemm-history.ps and eemm-history.pdf
	\| Starting simulation for process 'eemm'
	\| Simulate: using integration grids from file 'eemm_m1.vg'
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 29913
	\| OpenMP: Using 8 threads
	\| Simulation: requested number of events = 0
	\| corr. to luminosity [fb-1] = 0.0000E+00
	\| Events: writing to raw file 'eemm.evx'
	\| Events: generating 0 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: closing raw file 'eemm.evx'
	\| There were no errors and 1 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	\end{verbatim}
	\end{footnotesize}

	So, \whizard\ tells you that it has entered simulation mode, but besides
	this, it has not done anything. The next step is that you have to
	demand event generation -- there are two ways to do this: you could
	either specify a certain number, say 42, of events you want to have
	generated by \whizard, or you could provide a number for an integrated
	luminosity of some experiment. (Note, that if you choose to take both
	options, \whizard\ will take the one which gives the larger event
	sample. This, of course, depends on the given process(es) -- as well
	as cuts -- and its corresponding cross section(s).) The first of these
	options is set with the command: \ttt{n\_events = <number>}, the
	second with \ttt{luminosity = <number> <opt. unit>}.

	Another important point already stated several times in the manual is
	that \whizard\ follows the commands in the steering \sindarin\ file in a
	chronological order. Hence, a given number of events or luminosity
	{\em after} a \ttt{simulate} command will be ignored -- or are
	relevant only for any \ttt{simulate} command potentially following
	further down in the \sindarin\ file. So, in our case, try:
	\begin{verbatim}
	n_events = 500
	luminosity = 10
	simulate (eemm)
	\end{verbatim}
	Per default, numbers for integrated luminosity are understood as
	inverse femtobarn. So, for the cross section above this would
	correspond to 4283 events, clearly superseding the demand for 500
	events. After reducing the luminosity number from ten to one inverse
	femtobarn, 500 is the larger number of events taken by \whizard\ for
	event generation. Now \whizard\ tells you:
	\begin{verbatim}
	\| Simulation: requested number of events = 500
	\| corr. to luminosity [fb-1] = 1.1673E+00
	\| Events: reading from raw file 'eemm.evx'
	\| Events: reading 500 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event file terminates after 0 events.
	\| Events: appending to raw file 'eemm.evx'
	\| Generating remaining 500 events ...
	\| ... event sample complete.
	\| Events: closing raw file 'eemm.evx'
	\end{verbatim}
	I.e., it evaluates the luminosity to which the sample of 500 events
	would correspond to, which is now, of course, bigger than the $1
	\fb^{-1}$ explicitly given for the luminosity. Furthermore, you can
	read off that a file \ttt{whizard.evx} has been generated, containing
	the demanded 500 events. (It was there before containing zero events,
	because to \ttt{n\_events} or \ttt{luminosity} value had been
	set. \whizard\ then tried to get the events first from file before
	generating new ones). Files with the suffix \ttt{.evx} are binary
	format event files, using a machine-dependent \whizard-specific
	event file format. Before we list the event formats supported by
	\whizard, the next two sections will tell you more about unweighted and
	weighted events as well as different possibilities to normalize events
	in \whizard.

	As already explained for the libraries, as well as the phase space and
	grid files in Chap.~\ref{chap:sindarin}, \whizard\ is trying to re-use
	as much information as possible. This is of course also true for the
	event files. There are special MD5 check sums testing the integrity
	and compatibility of the event files. If you demand for a process for
	which an event file already exists (as in the example above, though it
	was empty) equally many or less events than generated before,
	\whizard\ will not generate again but re-use the existing events (as
	already explained, the events are stored in a \whizard-own
	binary event format, i.e. in a so-called \ttt{.evx} file. If you
	suppress generation of that file, as will be described in subsection
	\ref{sec:eventformats} then \whizard\ has to generate events all the
	time). From version v2.2.0 of \whizard\ on, the program is also able
	to read in event from different event formats. However, most event
	formats do not contain as many information as \whizard's internal
	format, and a complete reconstruction of the events might not be
	possible. Re-using event files is very practical for doing several
	different analyses with the same data, especially if there are many
	and big data samples. Consider
	the case, there is an event file with 200 events, and you now ask
	\whizard\ to generate 300 events, then it will re-use the 200 events
	(if MD5 check sums are OK!), generate the remaining 100 events and
	append them to the existing file. If the user for some reason,
	however, wants to regenerate events (i.e. ignoring possibly existing
	events), there is the command option \ttt{whizard --rebuild-events}.

	%%%%%%%%%

	\section{Unweighted and weighted events}

	\whizard\ is able to generate unweighted events, i.e. events that are
	distributed uniformly and each contribute with the same event weight
	to the whole sample. This is done by mapping out the phase space of
	the process under consideration according to its different phase space
	channels (which each get their own weights), and then unweighting the
	sample of weighted events. Only a sample of unweighted events could in
	principle be compared to a real data sample from some experiment. The
	seventh column in the \whizard\ iteration/adaptation procedure tells you
	about the efficiency of the grids, i.e. how well the phase space is
	mapped to a flat function. The better this is achieved, the higher the
	efficiency becomes, and the closer the weights of the different phase
	space channels are to uniformity. This means, for higher efficiency
	less weighted events ("calls") are needed to generate a single
	unweighted event. An efficiency of 10 \% means that ten weighted
	events are needed to generate one single unweighted event. After the
	integration is done, \whizard\ uses the duration of calls during the
	adaptation to estimate a time interval needed to generate 10,000
	unweighted events. The ability of the adaptive multi-channel Monte
	Carlo decreases with the number of integrations, i.e. with the number
	of final state particles. Adding more and more final state particles
	in general also increases the complexity of phase space, especially
	its singularity structure. For a $2 \to 2$ process the efficiency is
	roughly of the order of several tens of per cent. As a rule of thumb,
	one can say that with every additional pair of final state particle
	the average efficiency one can achieve decreases by a factor of five
	to ten.

	The default of \whizard\ is to generate {\em unweighted} events. One can
	use the logical variable \ttt{?unweighted = false} to disable
	unweighting and generate weighted events. (The command
	\ttt{?unweighted = true} is a tautology, because \ttt{true} is the
	default for this variable.) Note that again this command has to appear
	{\em before} the corresponding \ttt{simulate} command, otherwise it will
	be ignored or effective only for any \ttt{simulate} command appearing
	later in the \sindarin\ file.

	In the unweighted procedure, \whizard\ is keeping track of the highest
	weight that has been appeared during the adaptation, and the
	efficiency for the unweighting has been estimated from the average
	value of the sampling function compared to the maximum value. In
	principle, during event generation no events should be generated whose
	sampling function value exceeds the maximum function value encountered
	during the grid adaptation. Sometimes, however, there are numerical
	fluctuations and such events are happening. They are called {\em
	excess events}. \whizard\ does keep track of these excess events
	during event generation and will report about them, e.g.:
	\begin{code}
	Warning: Encountered events with excess weight: 9 events ( 0.090 %)
	\| Maximum excess weight = 6.083E-01
	\| Average excess weight = 2.112E-04
	\end{code}
	Whenever in an event generation excess events appear, this shows that
	the adaptation of the sampling function has not been perfect. When the
	number of excess weights is a finite number of percent, you should
	inspect the phase-space setup and try to improve its settings to get a
	better adaptation.

	Generating \emph{weighted} events is, of course, much faster if the
	same number of events is requested. Each event carries a weight
	factor which is taken into account for any internal analysis
	(histograms), and written to file if an external file format has been
	selected. The file format must support event weights.

	In a weighted event sample, there is typically a fraction of events
	which effectively have weight zero, namely those that have been
	created by the phase-space sampler but do not pass the requested
	cuts. In the default setup, those events are silently dropped, such
	that the events written to file or available for analysis all have
	nonzero weight. However, dropping such events affects the overall
	normalization. If this has happened, the program will issue a warning
	of the form
	\begin{code}
	\| Dropped events (weight zero) = 1142 (total 2142)
	Warning: All event weights must be rescaled by f = 4.66853408E-01
	\end{code}
	This factor has to be applied by hand to any external event files (and
	to internally generated histograms). The program cannot include the
	factor in the event records, because it is known only after all events
	have been generated. To avoid this problem, there is the logical flag
	\ttt{?keep\_failed\_events} which tells \whizard\ not to drop events with
	weight zero. The normalization will be correct, but the event sample
	will include invalid events which have to be vetoed by their zero
	weight, before any operations on the event record are performed.


	%%%%%%%%%

	\section{Choice on event normalizations}

	There are basically four different choices to normalize event weights
	($\braket{\ldots}$ denotes the average):
	\begin{enumerate}
	\item $\braket{w_i} = 1$, \qquad\qquad $\Braket{\sum_i w_i} = N$
	\item $\braket{w_i} = \sigma$, \qquad\qquad $\Braket{\sum_i w_i} = N
	\times \sigma$
	\item $\braket{w_i} = 1/N$, \quad\qquad $\Braket{\sum_i w_i} = 1$
	\item $\braket{w_i} = \sigma/N$, \quad\qquad $\Braket{\sum_i w_i} = \sigma$
	\end{enumerate}
	So the four options are to have the average weight equal to unity, to
	the cross section of the corresponding process, to one over the number
	of events, or the cross section over the event calls. In these four
	cases, the event weights sum up to the event number, the event number
	times the cross section, to unity, and to the cross section,
	respectively. Note that neither of these really guarantees that all
	event weights individually lie in the interval $0 \leq w_i \leq 1$.

	The user can steer the normalization of events by using in \sindarin\
	input files the string variable \ttt{\$sample\_normalization}. The default is
	\ttt{\$sample\_normalization = "auto"}, which uses option 1 for
	unweighted and 2 for weighted events, respectively. Note that this is
	also what the Les Houches Event Format (LHEF) demands for both types
	of events. This is \whizard's preferred mode, also for the reason, that
	event normalizations are independent from the number of events. Hence,
	event samples can be cut or expanded without further need to adjust
	the normalization. The unit normalization (option 1) can be switched
	on also for weighted events by setting the event normalization
	variable equal to \ttt{"1"}. Option 2 can be demanded
	by setting \ttt{\$sample\_normalization = "sigma"}. Options 3 and 4 can
	be set by \ttt{"1/n"} and \ttt{"sigma/n"}, respectively. \whizard\
	accepts small and capital letters for these expressions.

	There are several event formats (based upon the old common block
	definition HEPRUP) like some of the ASCII formats, LHA, LHE and HepMC
	that demand cross sections (and corresponding MCintegration errors) to
	be given in picobarn. So they are converted from the \whizard\ default
	of femtobarn to picobarn. The only exception is if a (pseudo-)event
	file for a decay is generated where the unit in those entries is
	downscaled by a factor of 1000, but remains in GeV as default unit.

	In the following section we show some examples when discussing the
	different event formats available in \whizard.

	%%%%%%%%%

	\section{Event selection}

	The \ttt{selection} expression (cf.\ Sec.~\ref{subsec:analysis})
	reduces the event sample during generation or rescanning, selecting
	only events for which the expression evaluates to \ttt{true}. Apart
	from internal analysis, the selection also applies to writing external
	files. For instance, the following code generates a $e^+e^-\to
	W^+W^-$ sample with longitudinally polarized $W$ bosons only:
	\begin{footnotesize}
	\begin{verbatim}
	process ww = "e+", "e-" => "W-", "W+"
	polarized "W+"
	polarized "W-"
	?polarized_events = true
	sqrts = 500
	selection = all Hel == 0 ["W+":"W-"]
	simulate (ww) { n_events = 1000 }
	\end{verbatim}
	\end{footnotesize}
	The number of events that end up in the sample on file is equal to the
	number of events with longitudinally polarized $W$s in the generated
	sample, so the file will contain less than 1000 events.


	%%%%%%%%%

	\section{Supported event formats}
	\label{sec:eventformats}

	Event formats can either be distinguished whether they are plain
	text (i.e. ASCII) formats or binary formats. Besides this, one can
	classify event formats according to whether they are natively
	supported by \whizard\ or need some external program or library to be
	linked. Table~\ref{tab:eventformats} gives a complete list of all
	event formats available in \whizard. The second column shows whether
	these are ASCII or binary formats, the third column contains brief
	remarks about the corresponding format, while the last column tells
	whether external programs or libraries are needed (which is the case
	only for the HepMC formats).

	\begin{table}
	\begin{center}
	\begin{tabular}{\|l\|\|l\|l\|r\|}\hline
	Format & Type & remark & ext. \\\hline
	ascii & ASCII & \whizard\ verbose format & no
	\\
	Athena & ASCII & variant of HEPEVT & no
	\\
	debug & ASCII & most verbose \whizard\ format & no
	\\
	evx & binary & \whizard's home-brew & no
	\\
	HepMC & ASCII & HepMC format & yes
	\\
	HEPEVT & ASCII & \whizard~1 style & no
	\\
	LCIO & ASCII & LCIO format & yes
	\\
	LHA & ASCII & \whizard~1/old Les Houches style &no
	\\
	LHEF & ASCII & Les Houches accord compliant & no
	\\
	long & ASCII & variant of HEPEVT & no
	\\
	mokka & ASCII & variant of HEPEVT & no
	\\
	short & ASCII & variant of HEPEVT & no
	\\
	StdHEP (HEPEVT) & binary & based on HEPEVT common block & no
	\\
	StdHEP (HEPRUP/EUP) & binary & based on HEPRUP/EUP common block
	& no \\
	Weight stream & ASCII & just weights & no \\
	\hline
	\end{tabular}
	\end{center}
	\caption{\label{tab:eventformats}
	Event formats supported by \whizard, classified according to
	ASCII/binary formats and whether an external program or library is
	needed to generate a file of this format. For both the HEPEVT and
	the LHA format there is a more verbose variant.
	}
	\end{table}
	The "\ttt{.evx}'' is \whizard's native binary event format. If you
	demand event generation and do not specify anything further, \whizard\
	will write out its events exclusively in this binary format. So in the
	examples discussed in the previous chapters (where we omitted all
	details about event formats), in all cases this and only this internal
	binary format has been generated. The generation of this raw format
	can be suppressed (e.g. if you want to have only one specific event
	file type) by setting the variable \verb\|?write_raw = false\|. However,
	if the raw event file is not present, \whizard\ is not able to re-use
	existing events (e.g. from an ASCII file) and will regenerate events
	for a given process. Note that from version v2.2.0 of \whizard\ on,
	the program is able to (partially) reconstruct complete events also
	from other formats than its internal format (e.g. LHEF), but this is
	still under construction and not yet complete.

	Other event formats can be written out by setting the variable
	\ttt{sample\_format = <format>}, where \ttt{<format>} can be any of
	the following supported variables:
	\begin{itemize}
	\item \ttt{ascii}: a quite verbose ASCII format which contains lots of
	information (an example is shown in the appendix). \newline
	Standard suffix: \ttt{.evt}
	\item \ttt{debug}: an even more verbose ASCII format intended for
	debugging which prints out also information about the internal data
	structures \newline
	Standard suffix: \ttt{.debug}
	\item \ttt{hepevt}: ASCII format that writes out a specific
	incarnation of the HEPEVT common block (\whizard~1
	back-compatibility) \newline
	Standard suffix: \ttt{.hepevt}
	\item \ttt{hepevt\_verb}: more verbose version of \ttt{hepevt} (\whizard~1
	back-compatibility) \newline
	Standard suffix: \ttt{.hepevt.verb}
	\item \ttt{short}: abbreviated variant of the previous HEPEVT (\whizard\
	1 back-compatibility) \newline
	Standard suffix: \ttt{.short.evt}
	\item \ttt{long}: HEPEVT variant that contains a little bit more
	information than the short format but less than HEPEVT (\whizard\
	1 back-compatibility) \newline
	Standard suffix: \ttt{.long.evt}
	\item \ttt{athena}: HEPEVT variant suitable for read-out in the ATLAS
	ATHENA software environment (\whizard\
	1 back-compatibility) \newline
	Standard suffix: \ttt{.athena.evt}
	\item \ttt{mokka}: HEPEVT variant suitable for read-out in the MOKKA
	ILC software environment \newline
	Standard suffix: \ttt{.mokka.evt}
	\item \ttt{lcio}: LCIO ASCII format (only available if LCIO is
	installed and correctly linked) \newline
	Standard suffix: \ttt{.lcio}
	\item \ttt{lha}: Implementation of the Les Houches Accord as it was in
	the old MadEvent and \whizard~1 \newline
	Standard suffix: \ttt{.lha}
	\item \ttt{lha\_verb}: more verbose version of \ttt{lha} \newline
	Standard suffix: \ttt{.lha.verb}
	\item \ttt{lhef}: Formatted Les Houches Accord implementation that
	contains the XML headers \newline
	Standard suffix: \ttt{.lhe}
	\item \ttt{hepmc}: HepMC ASCII format (only available if HepMC is
	installed and correctly linked) \newline
	Standard suffix: \ttt{.hepmc}
	\item \ttt{stdhep}: StdHEP binary format based on the HEPEVT common
	block
	\newline
	Standard suffix: \ttt{.hep}
	\item \ttt{stdhep\_up}: StdHEP binary format based on the HEPRUP/HEPEUP
	common blocks
	\newline
	Standard suffix: \ttt{.up.hep}
	\item \ttt{stdhep\_ev4}: StdHEP binary format based on the HEPEVT/HEPEV4
	common blocks
	\newline
	Standard suffix: \ttt{.ev4.hep}
	\item \ttt{weight\_stream}: Format that prints out only the event
	weight (and maybe alternative ones) \newline
	Standard suffix: \ttt{.weight.dat}
	\end{itemize}
	Of course, the variable \ttt{sample\_format} can contain more than one
	of the above identifiers, in which case more than one different event
	file format is generated. The list above also shows the standard
	suffixes for these event formats (remember, that the native binary
	format of \whizard\ does have the suffix \ttt{.evx}). (The suffix of
	the different event formats can even be changed by the user by setting
	the corresponding variable \ttt{\$extension\_lhef = "foo"} or
	\ttt{\$extension\_ascii\_short = "bread"}. The dot is automatically
	included.)

	The name of the corresponding event sample is taken to be the string
	of the name of the first process in the \ttt{simulate}
	statement. Remember, that conventionally the events for all processes
	in one \ttt{simulate} statement will be written into one single event
	file. So \ttt{simulate (proc1, proc2)} will write events for the two
	processes \ttt{proc1} and \ttt{proc2} into one single event file with
	name \ttt{proc1.evx}. The name can be changed by the user with the
	command \ttt{\$sample = "<name>"}.

	The commands \ttt{\$sample} and \ttt{sample\_format} are both accepted
	as optional arguments of a \ttt{simulate} command, so e.g.
	\ttt{simulate (proc) \{ \$sample = "foo" sample\_format = hepmc \}}
	generates an event sample in the HepMC format for the process
	\ttt{proc} in the file \ttt{foo.hepmc}.

	Examples for event formats, for specifications of the event formats correspond
	the different accords and publications~\footnote{Some event formats, based on
	the \ttt{HEPEVT} or \ttt{HEPEUP} common blocks, use fixed-form ASCII output
	with a two-digit exponent for real numbers. There are rare cases (mainly,
	ISR photons) where the event record can contain numbers with absolute value
	less than $10^{-99}$. Since those numbers are not representable in that
	format, \whizard\ will set all non-zero numbers below that value to $\pm
	10^{-99}$, when filling either common block. Obviously, such values are
	physically irrelevant, but in the output they are representable and
	distinguishable from zero.}:

	\paragraph{HEPEVT:}

	The HEPEVT is an ASCII event format that does not contain an event
	file header. There is a one-line header for each single event,
	containing four entries. The number of particles in the event
	(\ttt{ISTHEP}), which is four for a fictitious example process $hh\to
	hh$, but could be larger if e.g. beam remnants are demanded to be included in the
	event. The second entry and third entry are the number of outgoing
	particles and beam remnants, respectively. The event weight is the
	last entry. For each particle in the event there are three lines:
	the first one is the status according to the HEPEVT format,
	\ttt{ISTHEP}, the second one the PDG code, \ttt{IDHEP}, then there are
	the one or two possible mother particle, \ttt{JMOHEP}, the first and
	last possible daughter particle, \ttt{JDAHEP}, and the polarization.
	The second line contains the three momentum components, $p_x$, $p_y$,
	$p_z$, the particle energy $E$, and its mass, $m$.
	The last line contains the position of the vertex in the event
	reconstruction.

	\begin{scriptsize}
	\begin{verbatim}
	4 2 0 3.0574068604E+08
	2 25 0 0 3 4 0
	0.0000000000E+00 0.0000000000E+00 4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
	0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
	2 25 0 0 3 4 0
	0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
	0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
	1 25 1 2 0 0 0
	-1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
	0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
	1 25 1 2 0 0 0
	1.4960220911E+02 4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
	0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
	\end{verbatim}
	\end{scriptsize}

	\paragraph{ASCII SHORT:}

	This is basically the same as the HEPEVT standard, but very much
	abbreviated. The header line for each event is identical, but the first
	line per particle does only contain the PDG and the polarization,
	while the vertex information line is omitted.

	\begin{scriptsize}
	\begin{verbatim}
	4 2 0 3.0574068604E+08
	25 0
	0.0000000000E+00 0.0000000000E+00 4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
	25 0
	0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
	25 0
	-1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
	25 0
	1.4960220911E+02 4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
	\end{verbatim}
	\end{scriptsize}

	\paragraph{ASCII LONG:}

	Identical to the ASCII short format, but after each event there is a
	line containg two values: the value of the sample function to be
	integrated over phase space, so basically the squared matrix element
	including all normalization factors, flux factor, structure functions
	etc.

	\begin{scriptsize}
	\begin{verbatim}
	4 2 0 3.0574068604E+08
	25 0
	0.0000000000E+00 0.0000000000E+00 4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
	25 0
	0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
	25 0
	-1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
	25 0
	1.4960220911E+02 4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
	1.0000000000E+00 1.0000000000E+00
	\end{verbatim}
	\end{scriptsize}

	\paragraph{ATHENA:}

	Quite similar to the HEPEVT ASCII format. The header line, however,
	does contain only two numbers: an event counter, and the number of
	particles in the event. The first line for each particle lacks the
	polarization information (irrelevant for the ATHENA environment), but
	has as leading entry an ordering number counting the particles in the
	event. The vertex information line has only the four relevant position
	entries.


	\begin{scriptsize}
	\begin{verbatim}
	0 4
	1 2 25 0 0 3 4
	0.0000000000E+00 0.0000000000E+00 4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
	0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
	2 2 25 0 0 3 4
	0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02 5.0000000000E+02 1.2500000000E+02
	0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
	3 1 25 1 2 0 0
	-1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
	0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
	4 1 25 1 2 0 0
	1.4960220911E+02 4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02
	0.0000000000E+00 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00
	\end{verbatim}
	\end{scriptsize}

	\paragraph{MOKKA:}

	Quite similar to the ASCII short format, but the event entries are the
	particle status, the PDG code, the first and last daughter, the
	three spatial components of the momentum, as well as the mass.

	\begin{scriptsize}
	\begin{verbatim}
	4 2 0 3.0574068604E+08
	2 25 3 4 0.0000000000E+00 0.0000000000E+00 4.8412291828E+02 1.2500000000E+02
	2 25 3 4 0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02 1.2500000000E+02
	1 25 0 0 -1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00 1.2500000000E+02
	1 25 0 0 1.4960220911E+02 4.6042825611E+02 0.0000000000E+00 1.2500000000E+02
	\end{verbatim}
	\end{scriptsize}

	\paragraph{LHA:}

	This is the implementation of the Les Houches Accord, as it was used
	in \whizard\ 1 and the old MadEvent. There is a first line containing
	six entries: 1. the number of particles in the event, \ttt{NUP},
	2. the subprocess identification index, \ttt{IDPRUP}, 3. the event
	weight, \ttt{XWGTUP}, 4. the scale of the process, \ttt{SCALUP},
	5. the value or status of $\alpha_{QED}$, \ttt{AQEDUP}, 6. the value
	for $\alpha_s$, \ttt{AQCDUP}. The next seven lines contain as many
	entries as there are particles in the event: the first one has the PDG
	codes, \ttt{IDUP}, the next two the first and second mother of the particles,
	\ttt{MOTHUP}, the fourth and fifth line the two color indices,
	\ttt{ICOLUP}, the next one the status of the particle, \ttt{ISTUP},
	and the last line the polarization information, \ttt{ISPINUP}.
	At the end of the event there are as lines for each particles with the
	counter in the event and the four-vector of the particle. For more
	information on this event format confer~\cite{LesHouches}.

	\begin{scriptsize}
	\begin{verbatim}
	25 25 5.0000000000E+02 5.0000000000E+02 -1 -1 -1 -1 3 1
	1.0000000000E-01 1.0000000000E-03 1.0000000000E+00 42
	4 1 3.0574068604E+08 1.000000E+03 -1.000000E+00 -1.000000E+00
	25 25 25 25
	0 0 1 1
	0 0 2 2
	0 0 0 0
	0 0 0 0
	-1 -1 1 1
	9 9 9 9
	1 5.0000000000E+02 0.0000000000E+00 0.0000000000E+00 4.8412291828E+02
	2 5.0000000000E+02 0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02
	3 5.0000000000E+02 -1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00
	4 5.0000000000E+02 1.4960220911E+02 4.6042825611E+02 0.0000000000E+00
	\end{verbatim}
	\end{scriptsize}

	\paragraph{LHEF:}

	This is the modern version of the Les Houches accord event format
	(LHEF), for the details confer the corresponding publication~\cite{LHEF}.

	\begin{scriptsize}
	\begin{verbatim}
	<LesHouchesEvents version="1.0">
	<header>
	<generator_name>WHIZARD</generator_name>
	<generator_version>3.1.3</generator_version>
	</header>
	<init>
	25 25 5.0000000000E+02 5.0000000000E+02 -1 -1 -1 -1 3 1
	1.0000000000E-01 1.0000000000E-03 1.0000000000E+00 42
	</init>
	<event>
	4 42 3.0574068604E+08 1.0000000000E+03 -1.0000000000E+00 -1.0000000000E+00
	25 -1 0 0 0 0 0.0000000000E+00 0.0000000000E+00 4.8412291828E+02 5.0000000000E+02 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00
	25 -1 0 0 0 0 0.0000000000E+00 0.0000000000E+00 -4.8412291828E+02 5.0000000000E+02 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00
	25 1 1 2 0 0 -1.4960220911E+02 -4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00
	25 1 1 2 0 0 1.4960220911E+02 4.6042825611E+02 0.0000000000E+00 5.0000000000E+02 1.2500000000E+02 0.0000000000E+00 9.0000000000E+00
	</event>
	</LesHouchesEvents>
	\end{verbatim}
	\end{scriptsize}

	Note that for the LHEF format, there are different versions according
	to the different stages of agreement. They can be addressed from
	within the \sindarin\ file by setting the string variable
	\ttt{\$lhef\_version} to one of (at the moment) three values:
	\ttt{"1.0"}, \ttt{"2.0"}, or \ttt{"3.0"}. The examples above
	corresponds (as is indicated in the header) to the version \ttt{"1.0"}
	of the LHEF format. Additional information in form of alternative
	squared matrix elements or event weights in the event are the most
	prominent features of the other two more advanced versions. For more
	details confer the literature.

	\vspace{.5cm}

	Sample files for the default ASCII format as well as for the debug
	event format are shown in the appendix.

	%%%%%%%%%

	\section[Interfaces to Parton Showers, Matching and
	Hadronization]{Interfaces to Parton Showers, Matching\\and
	Hadronization}

	This section describes the interfaces to the internal parton shower as
	well as the parton shower and hadronization routines from
	\pythia. Moreover, our implementation of the MLM matching making use
	of the parton showers is described. Sample \sindarin\ files are
	located in the \ttt{share/examples} directory.
	All input files come in two versions, one using the internal shower,
	ending in \ttt{W.sin}, and one using \pythia's shower, ending in
	\ttt{P.sin}. Thus we state all file names as ending with \ttt{X.sin},
	where \ttt{X} has to be replaced by either \ttt{W} or \ttt{P}.
	The input files include \ttt{EENoMatchingX.sin} and
	\ttt{DrellYanNoMatchingX.sin} for $e^+ e^- \to hadrons$ and $p\bar{p}
	\to Z$ without matching. The corresponding \sindarin\ files with
	matching enabled are \ttt{EEMatching2X.sin} to \ttt{EEMatching5X.sin}
	for $e^+ e^- \to hadrons$ with a different number of partons included
	in the matrix element and \ttt{DrallYanMatchingX.sin} for Drell-Yan
	with one matched emission.

	\subsection{Parton Showers and Hadronization}

	From version 2.1 onwards, \whizard\ contains an implementation of an
	analytic parton shower as presented in \cite{Kilian:2011ka}, providing
	the opportunity to perform the parton shower from whithin
	\whizard. Moreover, an interface to \pythia\ is included, which can be
	used to delegate the parton shower to \pythia. The same interface can
	be used to hadronize events using the generated events using \pythia's
	hadronization routines. Note that by \pythia's default, when
	performing initial-state radiation multiple interactions are included
	and when performing the hadronization hadronic decays are included. If
	required, these additional steps have to be switched off using the
	corresponding arguments for \pythia's \ttt{PYGIVE} routine via the
	\ttt{\$ps\_PYTHIA\_PYGIVE} string.

	Note that from version 2.2.4 on the earlier flag
	\ttt{--enable-shower} flag has been abandoned, and there is only a
	flag to either compile or not compile the interally attached
	\pythia\ttt{6} package (\ttt{--enable-pythia6}) last release of
	the \fortran\ \pythia, v6.427) as well as the interface. It can be
	invoked by the following \sindarin\ keywords:\\[2ex]
	%
	\centerline{\begin{tabular}{\|l\|l\|}
	\hline\ttt{?ps\_fsr\_active = true} & master switch for final-state
	parton showers\\\hline
	\ttt{?ps\_isr\_active = true} & master switch for initial-state parton
	showers\\\hline
	\ttt{?ps\_taudec\_active = true} & master switch for $\tau$ decays (at
	the moment only via \ttt{TAUOLA}\\\hline
	\ttt{?hadronization\_active = true} & master switch to enable
	hadronization\\\hline
	\ttt{\$shower\_method = "PYTHIA6"} & switch to use \pythiasix's parton
	shower instead of \\ &
	\whizard's own shower\\\hline
	\end{tabular}}\mbox{}

	\vspace{4mm}

	If either \ttt{?ps\_fsr\_active} or \ttt{?ps\_isr\_active} is set to \verb\|true\|, the
	event will be transferred to the internal shower routines or the \pythia\ data structures,
	and the chosen shower steps (initial- and final-state radiation) will be
	performed. If hadronization is enabled via the \ttt{?hadronization\_active} switch, \whizard\ will call \pythia's hadronization routine.
	The hadron\-ization can be applied to events showered using the internal shower or showered using \pythia's shower routines, as well as unshowered events.
	Any necessary transfer of event data to \pythia\ is automatically taken care of within \whizard's shower interface.
	The resulting (showered and/or hadronized) event will be transferred back to \whizard,
	the former final particles will be marked as intermediate. The
	analysis can be applied to a showered and/or hadronized event just
	like in the unshowered/unhadronized case. Any event file can be used
	and will contain the showered/hadronized event.

	Settings for the internal analytic parton shower are set via the following \sindarin\ variables:\\[2ex]
	\begin{description}
	\item[\ttt{ps\_mass\_cutoff}] The cut-off in virtuality, below
	which, partons are assumed to radiate no more. Used for both ISR and
	FSR. Given in $\mbox{GeV}$. (Default = 1.0)
	\item[\ttt{ps\_fsr\_lambda}] The value for $\Lambda$ used in
	calculating the value of the running coupling constant $\alpha_S$
	for Final State Radiation. Given in $\mbox{GeV}$. (Default = 0.29)
	\item[\ttt{ps\_isr\_lambda}] The value for $\Lambda$ used in
	calculating the value of the running coupling constant $\alpha_S$
	for Initial State Radiation. Given in $\mbox{GeV}$. (Default = 0.29)
	\item[\ttt{ps\_max\_n\_flavors}] Number of quark flavours taken
	into account during shower evolution. Meaningful choices are 3 to
	include $u,d,s$-quarks, 4 to include $u,d,s,c$-quarks and 5 to
	include $u,d,s,c,b$-quarks. (Default = 5)
	\item[\ttt{?ps\_isr\_alphas\_running}] Switch to decide between a
	constant $\alpha_S$, given by \ttt{ps\_fixed\_alphas}, and a
	running $\alpha_S$, calculated using \ttt{ps\_isr\_lambda} for
	ISR. (Default = true)
	\item[\ttt{?ps\_fsr\_alphas\_running}] Switch to decide between a
	constant $\alpha_S$, given by \ttt{ps\_fixed\_alphas}, and a
	running $\alpha_S$, calculated using \ttt{ps\_fsr\_lambda} for
	FSR. (Default = true)
	\item[\ttt{ps\_fixed\_alphas}] Fixed value of $\alpha_S$ for the
	parton shower. Used if either one of the variables
	\ttt{?ps\_fsr\_alphas\_running}
	or \ttt{?ps\_isr\_alphas\_running} are set to
	\verb\|false\|. (Default = 0.0)
	\item[\ttt{?ps\_isr\_angular\_ordered}] Switch for angular ordered
	ISR. (Default = true )\footnote{The FSR is always simulated with
	angular ordering enabled.}
	\item[\ttt{ps\_isr\_primordial\_kt\_width}] The width in
	$\mbox{GeV}$ of the Gaussian assumed to describe the transverse
	momentum of partons inside the proton. Other shapes are not yet
	implemented. (Default = 0.0)
	\item[\ttt{ps\_isr\_primordial\_kt\_cutoff}] The maximal transverse
	momentum in $\mbox{GeV}$ of a parton inside the proton. Used as a
	cut-off for the Gaussian. (Default = 5.0)
	\item[\ttt{ps\_isr\_z\_cutoff}] Maximal $z$-value in initial state
	branchings. (Default = 0.999)
	\item[\ttt{ps\_isr\_minenergy}] Minimal energy in $\mbox{GeV}$ of
	an emitted timelike or final parton. Note that the energy is not
	calculated in the labframe but in the center-of-mas frame of the two
	most initial partons resolved so far, so deviations may
	occur. (Default = 1.0)
	\item[\ttt{ps\_isr\_tscalefactor}] Factor for the starting scale in
	the initial state shower evolution. ( Default = 1.0 )
	\item[\ttt{?ps\_isr\_only\_onshell\_emitted\_partons}] Switch to
	allow only for on-shell emitted partons, thereby rejecting all
	possible final state parton showers starting from partons emitted
	during the ISR. (Default = false)
	\end{description}

	Settings for the \pythia\ are transferred using the following
	\sindarin\ variables:\\[2ex]
	\centerline{\begin{tabular}{\|l\|l\|}
	\hline\ttt{?ps\_PYTHIA\_verbose} & if set to false, output from
	\pythia\ will be suppressed\\\hline
	\ttt{\$ps\_PYTHIA\_PYGIVE} & a string containing settings transferred
	to \pythia's \ttt{PYGIVE} subroutine.\\ & The format is explained in
	the \pythia\ manual. The limitation to 100 \\ & characters mentioned
	there does not apply here, the string is split \\ & appropriately
	before being transferred to \pythia.\\\hline
	\end{tabular}}\mbox{}

	\vspace{4mm}

	Note that the included version of \pythia\ uses \lhapdf\ for initial state
	radiation whenever this is available, but the PDF set has to be set
	manually in that case using the keyword \ttt{ps\_PYTHIA\_PYGIVE}.

	\subsection{Parton shower -- Matrix Element Matching}

	Along with the inclusion of the parton showers, \whizard\ includes an
	implementation of the MLM matching procedure. For a detailed
	description of the implemented steps see \cite{Kilian:2011ka}. The
	inclusion of MLM matching still demands some manual settings in the
	\sindarin\ file. For a given base process and a matching of $N$
	additional jets, all processes that can be obtained by attaching up to
	$N$ QCD splittings, either a quark emitting a gluon or a gluon
	splitting into two quarks ar two gluons, have to be manually specified
	as additional processes. These additional processes need to be
	included in the \ttt{simulate} statement along with the original
	process. The \sindarin\ variable \ttt{mlm\_nmaxMEjets} has to be
	set to the maximum number of additional jets $N$. Moreover additional
	cuts have to be specified for the additional processes.
	\begin{verbatim}
	alias quark = u:d:s:c
	alias antiq = U:D:S:C
	alias j = quark:antiq:g

	?mlm_matching = true
	mlm_ptmin = 5 GeV
	mlm_etamax = 2.5
	mlm_Rmin = 1

	cuts = all Dist > mlm_Rmin [j, j]
	and all Pt > mlm_ptmin [j]
	and all abs(Eta) < mlm_etamax [j]
	\end{verbatim}
	Note that the variables \ttt{mlm\_ptmin}, \ttt{mlm\_etamax} and
	\ttt{mlm\_Rmin} are used by the matching routine. Thus, replacing the
	variables in the \ttt{cut} expression and omitting the assignment
	would destroy the matching procedure.

	The complete list of variables introduced to steer the matching procedure is as follows:
	\begin{description}
	\item[\ttt{?mlm\_matching\_active}] Master switch to enable MLM
	matching. (Default = false)
	\item[\ttt{mlm\_ptmin}] Minimal transverse momentum, also used in
	the definition of a jet
	\item[\ttt{mlm\_etamax}] Maximal absolute value of pseudorapidity
	$\eta$, also used in defining a jet
	\item[\ttt{mlm\_Rmin}] Minimal $\eta-\phi$ distance $R_{min}$
	\item[\ttt{mlm\_nmaxMEjets}] Maximum number of jets $N$
	\item[\ttt{mlm\_ETclusfactor}] Factor to vary the jet
	definition. Should be $\geq 1$ for complete coverage of phase
	space. (Default = 1)
	\item[\ttt{mlm\_ETclusminE}] Minimal energy in the variation of the
	jet definition
	\item[\ttt{mlm\_etaclusfactor}] Factor in the variation of the jet
	definition. Should be $\leq 1$ for complete coverage of phase
	space. (Default = 1)
	\item[\ttt{mlm\_Rclusfactor}] Factor in the variation of the jet
	definition. Should be $\ge 1$ for complete coverage of phase
	space. (Default = 1)
	\end{description}
	The variation of the jet definition is a tool to asses systematic
	uncertainties introduced by the matching procedure (See section 3.1 in
	\cite{Kilian:2011ka}).


	%%%%%%%%%

	\section{Rescanning and recalculating events}
	\label{sec:rescan}

	In the simplest mode of execution, \whizard\ handles its events at the
	point where they are generated. It can apply event transforms such as
	decays or shower (see above), it can analyze the events, calculate and
	plot observables, and it can output them to file. However, it is also
	possible to apply two different operations to those events in
	parallel, or to reconsider and rescan an event sample that has been
	previously generated.

	We first discuss the possibilities that \ttt{simulate} offers. For
	each event, \whizard\ calculates the matrix element for the hard
	interaction, supplements this by Jacobian and phase-space factors in
	order to obtain the event weight, optionally applies a rejection step
	in order to gather uniformly weighted events, and applies the
	cuts and analysis setup. We may ask about the event matrix element or
	weight, or the analysis result, that we would have obtained for a
	different setting. To this end, there is an \ttt{alt\_setup} option.

	This option allows us to recalculate, event by event, the matrix
	element, weight, or analysis contribution with a different parameter
	set but identical kinematics. For instance, we may evaluate a
	distribution for both zero and non-zero anomalous coupling \ttt{fw}
	and enter some observable in separate histograms:

	\begin{footnotesize}
	\begin{verbatim}
	simulate (some_proc) {
	fw = 0
	analysis = record hist1 (eval Pt [H])
	alt_setup = {
	fw = 0.01
	analysis = record hist2 (eval Pt [H])
	}
	}
	\end{verbatim}
	\end{footnotesize}

	In fact, the \ttt{alt\_setup} object is not restricted to a single
	code block (enclosed in curly braces) but can take a list of those,
	\begin{footnotesize}
	\begin{verbatim}
	alt_setup = { fw = 0.01 }, { fw = 0.02 }, ...
	\end{verbatim}
	\end{footnotesize}
	Each block provides the environment for a separate evaluation of the
	event data. The generation of these events, i.e., their kinematics,
	is still steered by the primary environment.

	The \ttt{alt\_setup} blocks may modify various settings that affect the
	evaluation of an event, including physical parameters, PDF choice,
	cuts and analysis, output format, etc. This must not (i.e., cannot)
	affect the kinematics of an event, so don't modify particle masses.
	When applying cuts, they can only reduce the generated event sample,
	so they apply on top of the primary cuts for the simulation.

	Alternatively, it is possible to \ttt{rescan} a sample that has been
	generated by a previous \ttt{simulate} command:
	\begin{footnotesize}
	\begin{verbatim}
	simulate (some_proc) { $sample = "my_events"
	analysis = record hist1 (eval Pt [H])
	}
	?update_sqme = true
	?update_weight = true
	rescan "my_events" (some_proc) {
	fw = 0.01
	analysis = record hist2 (eval Pt [H])
	}
	rescan "my_events" (some_proc) {
	fw = 0.05
	analysis = record hist3 (eval Pt [H])
	}
	\end{verbatim}
	\end{footnotesize}
	In more complicated situation, rescanning is more transparent and
	offers greater flexibility than doing all operations at the very point
	of event generation.

	Combining these features with the \ttt{scan} looping construct, we
	already cover a considerable range of applications. (There are
	limitations due to the fact that \sindarin\ doesn't provide array
	objects, yet.) Note that the \ttt{rescan} construct also allows
	for an \ttt{alt\_setup} option.

	You may generate a new sample by rescanning, for which you may choose
	any output format:
	\begin{footnotesize}
	\begin{verbatim}
	rescan "my_events" (some_proc) {
	selection = all Pt > 100 GeV [H]
	$sample = "new_events"
	sample_format = lhef
	}
	\end{verbatim}
	\end{footnotesize}

	The event sample that you rescan need not be an internal raw \whizard\
	file, as above. You may rescan a LHEF file,
	\begin{footnotesize}
	\begin{verbatim}
	rescan "lhef_events" (proc) {
	$rescan_input_format = "lhef"
	}
	\end{verbatim}
	\end{footnotesize}
	This file may have any origin, not necessarily from \whizard. To
	understand such an external file, \whizard\ must be able to
	reconstruct the hard process and match it to a process with a known
	name (e.g., \ttt{proc}), that has been defined in the \sindarin\ script
	previously.

	Within its limits, \whizard\ can thus be used for translating an event
	sample from one format to another format.

	There are three important switches that control the rescanning
	behavior. They can be set or unset independently.
	\begin{itemize}
	\item \ttt{?update\_sqme} (default: false).
	If true, \whizard\ will recalculate the hard matrix element for each
	event. When applying an analysis, the recalculated squared matrix
	element (averaged and summed over quantum numbers as usual) is
	available as the variable \ttt{sqme\_prc}. This may be related to
	\ttt{sqme\_ref}, the corresponding
	value in the event file, if available. (For the \ttt{alt\_env}
	option, this switch is implied.)
	\item \ttt{?update\_weight} (default: false).
	If true, \whizard\ will recalculate the event weight according to
	the current environment and apply this to the event. In particular,
	the user may apply a \ttt{reweight} expression. In an
	analysis, the new weight value is available as \ttt{weight\_prc}, to
	be related
	to \ttt{weight\_ref} from the sample. The updated weight will be
	applied for histograms and averages. An unweighted event sample
	will thus be transformed into a weighted event sample. (This switch
	is also implied for the \ttt{alt\_env} option.)
	\item \ttt{?update\_event} (default: false).
	If true, \whizard\ will generate a new decay chain etc., if
	applicable. That is, it reuses just the particles in the hard
	process. Otherwise, the complete event is kept as it is written to
	file.
	\end{itemize}
	For these options to make sense, \whizard\ must have access to a full
	process object, so the \sindarin\ script must contain not just a
	definition but also a \ttt{compile} command for the matrix elements in
	question.

	If an event file (other than raw format) contains several processes as
	a mixture, they must be identifiable by a numeric ID. \whizard\ will
	recognize the processes if their respective \sindarin\ definitions
	contain appropriate \ttt{process\_num\_id} options, such as
	\begin{footnotesize}
	\begin{verbatim}
	process foo = u, ubar => d, dbar { process_num_id = 42 }
	\end{verbatim}
	\end{footnotesize}

	Certain event-file formats, such as LHEF, support alternative
	matrix-element values or weights. \whizard\ can thus write both
	original and
	recalculated matrix-element and weight values.
	Other formats support only a single
	event weight, so the \ttt{?update\_weight} option is necessary for a
	visible effect.

	External event files in formats such as LHEF, HepMC, or LCIO, also may
	carry information about the value of the strong coupling $\alpha_s$
	and the energy scale of each event. This information will also be
	provided by \whizard\ when writing external event files. When such an
	event file is rescanned, the user has the choice to either user the
	$\alpha_s$ value that \whizard\ defines in the current context (or the
	method for obtaining an event-specific running $\alpha_s$ value), or
	override this for each event by using the value in the event file.
	The corresponding parameter is \ttt{?use\_alphas\_from\_file}, which
	is false by default. Analogously, the parameter
	\ttt{?use\_scale\_from\_file} may be set to override the scale
	definition in the current context. Obviously, these settings
	influence matrix-element recalculation and therefore require
	\ttt{?update\_sqme} to be set in order to become operational.

	%%%%%%%%%

	\section{Negative weight events}
	For usage at NLO refer to Subsection~\ref{ss:fixedorderNLOevents}.
	In case, you have some other mechanism to produce events with negative
	weights (e.g. with the \ttt{weight = {\em <expr>}} command), keep in
	mind that you should activate \ttt{?negative\_weights = true} and
	\ttt{unweighted = false}. The generation of unweighted events with
	varying sign (also known as events and counter events) is currently not
	supported.

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Internal Data Visualization}
	\label{chap:visualization}

	\section{GAMELAN}

	The data values and tables that we have introduced in the previous section can
	be visualized using built-in features of \whizard. To be precise,
	\whizard\ can write \LaTeX\ code which incorporates code in the graphics
	language GAMELAN to produce a pretty-printed account of observables,
	histograms, and plots.

	GAMELAN is a macro package for MetaPost, which is part of the
	\TeX/\LaTeX\ family. MetaPost, a derivative of Knuth's MetaFont language for
	font design, is usually bundled with the \TeX\ distribution, but might need a
	separate switch for installation. The GAMELAN macros are contained in a
	subdirectory of the \whizard\ package. Upon installation, they will be
	installed in the appropriate directory, including the \ttt{gamelan.sty} driver
	for \LaTeX. \whizard\ uses a subset of GAMELAN's graphics macros
	directly, but it allows for access to the full package if desired.

	An (incomplete) manual for GAMELAN can be found in the \ttt{share/doc}
	subdirectory of the \whizard\ system. \whizard\ itself uses a subset of the
	GAMELAN capabilities, interfaced by \sindarin\ commands and parameters. They
	are described in this chapter.

	To process analysis output beyond writing tables to file, the
	\ttt{write\_analysis} command described in the previous section should be
	replaced by \ttt{compile\_analysis}, with the same syntax:
	\begin{quote}
	\begin{footnotesize}
	\ttt{compile\_analysis (\emph{analysis-tags}) \{ \ttt{\emph{options}} \}}
	\end{footnotesize}
	\end{quote}
	where \ttt{\emph{analysis-tags}}, a comma-separated list of analysis objects,
	is optional. If there are no tags, all analysis objects are processed. The
	\ttt{\emph{options}} script of local commands is also optional, of course.

	This command will perform the following actions:
	\begin{enumerate}
	\item
	It writes a data file in default format, as \ttt{write\_analysis} would do.
	The file name is given by \ttt{\$out\_file}, if nonempty. The file must not
	be already open, since the command needs a self-contained file, but the name
	is otherwise arbitrary. If the value of \ttt{\$out\_file} is empty, the
	default file name is \ttt{whizard\_analysis.dat}.
	\item
	It writes a driver file for the chosen datasets, whose name is derived from
	the data file by replacing the file extension of the data file with the
	extension \ttt{.tex}. The driver file is a \LaTeX\ source file which
	contains embedded GAMELAN code that handles the selected graphics data. In
	the \LaTeX\ document, there is a separate section for each contained
	dataset. Furthermore, a process-/analysis-specific makefile with the
	name \ttt{<process\_name>\_ana.makefile} is created that can be used
	to generate postscript or PDF output from the \LaTeX\ source. If the
	steering flag \ttt{?analysis\_file\_only} is set to \ttt{true}, then
	the \LaTeX\ file and the makefile are only written, but no execution
	of the makefile resulting in compilation of the \LaTeX\ code (see
	the next item) is invoked.
	\item
	As mentioned above, if the flag \ttt{?analysis\_file\_only} is set
	to \ttt{false} (which is the default), the driver file is processed
	by \LaTeX (invoked by calling the makefile with the name
	\ttt{<process\_name>\_ana.makefile}), which generates an appropriate
	GAMELAN source file with extension \ttt{.mp}. This code is executed
	(calling GAMELAN/MetaPost, and again \LaTeX\ for typesetting embedded
	labels). There is a second \LaTeX\ pass (automatically done by the
	makefile) which collects the results, and finally conversion to
	PostScript and PDF formats.
	\end{enumerate}

	The resulting PostScript or PDF file -- the file name is the name of the data
	file with the extension replaced by \ttt{.ps} or \ttt{.pdf}, respectively
	-- can be printed or viewed with an appropriate viewer such as \ttt{gv}. The
	viewing command is not executed automatically by \whizard.

	Note that \LaTeX\ will write further files with extensions \ttt{.log},
	\ttt{.aux}, and \ttt{.dvi}, and GAMELAN will produce auxiliary files with
	extensions \ttt{.ltp} and \ttt{.mpx}. The log file in particular, could
	overwrite \whizard's log file if the basename is identical. Be careful to use
	a value for \ttt{\$out\_file} which is not likely to cause name clashes.


	\subsection{User-specific changes}

	In the case, that the \sindarin\ \ttt{compile\_analysis} command is
	invoked and the flag named \ttt{?analysis\_file\_only} is not changed
	from its default value \ttt{false}, \whizard\ calls the
	process-/analysis-specific makefile triggering the compilation of the
	\LaTeX\ code and the GAMELAN plots and histograms. If the user wants
	to edit the analysis output, for example changing captions, headlines,
	labels, properties of the plots, graphs and histograms using GAMELAN
	specials etc., this is possible and the output can be regenerated
	using the makefile. The user can also directly invoke the GAMELAN
	script, \ttt{whizard-gml}, that is installed in the binary directly
	along with the \whizard\ binary and other scripts. Note however, that
	the \LaTeX\ environment for the specific style files have to be set by
	hand (the command line invocation in the makefile does this
	automatically). Those style files are generally written into
	\ttt{share/texmf/whizard/} directory. The user can execute the
	commands in the same way as denoted in the process-/analysis-specific
	makefile by hand.


	%%%%%

	\section{Histogram Display}


	%%%%%

	\section{Plot Display}


	\section{Graphs}
	\label{sec:graphs}

	Graphs are an additional type of analysis object. In contrast to histograms
	and plots, they do not collect data directly, but they rather act as
	containers for graph elements, which are copies of existing histograms and
	plots. Their single purpose is to be displayed by the GAMELAN driver.

	Graphs are declared by simple assignments such as
	\begin{quote}
	\begin{footnotesize}
	\ttt{graph g1 = hist1}
	\\
	\ttt{graph g2 = hist2 \& hist3 \& plot1}
	\end{footnotesize}
	\end{quote}
	The first declaration copies a single histogram into the graph, the second one
	copies two histograms and a plot. The syntax for collecting analysis objects
	uses the \ttt{\&} concatenation operator, analogous to string concatenation.
	In the assignment, the rhs must contain only histograms and plots. Further
	concatenating previously declared graphs is not supported.

	After the graph has been declared, its contents can be written to file
	(\ttt{write\_analysis}) or, usually, compiledd by the \LaTeX/GAMELAN driver
	via the \ttt{compile\_analysis} command.

	The graph elements on the right-hand side of the graph assignment are copied
	with their current data content. This implies a well-defined order of
	statements: first, histograms and plots are declared, then they are filled via
	\ttt{record} commands or functions, and finally they can be collected for
	display by graph declarations.

	A simple graph declaration without options as above is possible, but usually
	there are options which affect the graph display. There are two kinds of
	options: graph options and drawing options. Graph options apply to the graph
	as a whole (title, labels, etc.) and are placed in braces on the lhs of the
	assigment. Drawing options apply to the individual graph elements
	representing the contained histograms and plots, and are placed together with
	the graph element on the rhs of the assignment. Thus, the complete syntax for
	assigning multiple graph elements is
	\begin{quote}
	\begin{footnotesize}
	\ttt{graph \emph{graph-tag} \{ \emph{graph-options} \}}
	\\
	\ttt{= \emph{graph-element-tag1} \{ \emph{drawing-options1} \}}
	\\
	\ttt{\& \emph{graph-element-tag2} \{ \emph{drawing-options2} \}}
	\\
	\ldots
	\end{footnotesize}
	\end{quote}
	This form is recommended, but graph and drawing options can also be set as
	global parameters, as usual.

	We list the supported graph and drawing options in
	Tables~\ref{tab:graph-options} and \ref{tab:drawing-options}, respectively.

	\begin{table}
	\caption{Graph options. The content of strings of type \LaTeX\ must be
	valid \LaTeX\ code (containing typesetting commands such as math mode).
	The content of strings of type GAMELAN must be valid GAMELAN code.
	If a graph bound is kept \emph{undefined}, the actual graph bound is
	determined such as not to crop the graph contents in the selected
	direction.}
	\label{tab:graph-options}

	\begin{center}
	\begin{tabular}{\|l\|l\|l\|l\|}
	\hline
	Variable & Default & Type & Meaning
	\\
	\hline\hline
	\ttt{\$title} & \ttt{""} & \LaTeX &
	Title of the graph = subsection headline
	\\
	\hline
	\ttt{\$description} & \ttt{""} & \LaTeX &
	Description text for the graph
	\\
	\hline
	\ttt{\$x\_label} & \ttt{""} & \LaTeX &
	$x$-axis label
	\\
	\hline
	\ttt{\$y\_label} & \ttt{""} & \LaTeX &
	$y$-axis label
	\\
	\hline
	\ttt{graph\_width\_mm} & 130 & Integer &
	graph width (on paper) in mm
	\\
	\hline
	\ttt{graph\_height\_mm} & 90 & Integer &
	graph height (on paper) in mm
	\\
	\hline
	\ttt{?x\_log} & false & Logical &
	Whether the $x$-axis scale is linear or logarithmic
	\\
	\hline
	\ttt{?y\_log} & false & Logical &
	Whether the $y$-axis scale is linear or logarithmic
	\\
	\hline
	\ttt{x\_min} & \emph{undefined} & Real &
	Lower bound for the $x$ axis
	\\
	\hline
	\ttt{x\_max} & \emph{undefined} & Real &
	Upper bound for the $x$ axis
	\\
	\hline
	\ttt{y\_min} & \emph{undefined} & Real &
	Lower bound for the $y$ axis
	\\
	\hline
	\ttt{y\_max} & \emph{undefined} & Real &
	Upper bound for the $y$ axis
	\\
	\hline
	\ttt{gmlcode\_bg} & \ttt{""} & GAMELAN &
	Code to be executed before drawing
	\\
	\hline
	\ttt{gmlcode\_fg} & \ttt{""} & GAMELAN &
	Code to be executed after drawing
	\\
	\hline
	\end{tabular}
	\end{center}
	\end{table}

	\begin{table}
	\caption{Drawing options. The content of strings of type GAMELAN must be
	valid GAMELAN code. The behavior w.r.t. the flags with \emph{undefined}
	default value depends on the type of graph element. Histograms: draw
	baseline, piecewise, fill area, draw curve, no errors, no symbols; Plots:
	no baseline, no fill, draw curve, no errors, no symbols.}
	\label{tab:drawing-options}

	\begin{center}
	\begin{tabular}{\|l\|l\|l\|l\|}
	\hline
	Variable & Default & Type & Meaning
	\\
	\hline\hline
	\ttt{?draw\_base} & \emph{undefined} & Logical &
	Whether to draw a baseline for the curve
	\\
	\hline
	\ttt{?draw\_piecewise} & \emph{undefined} & Logical &
	Whether to draw bins separately (histogram)
	\\
	\hline
	\ttt{?fill\_curve} & \emph{undefined} & Logical &
	Whether to fill area between baseline and curve
	\\
	\hline
	\ttt{\$fill\_options} & \ttt{""} & GAMELAN &
	Options for filling the area
	\\
	\hline
	\ttt{?draw\_curve} & \emph{undefined} & Logical &
	Whether to draw the curve as a line
	\\
	\hline
	\ttt{\$draw\_options} & \ttt{""} & GAMELAN &
	Options for drawing the line
	\\
	\hline
	\ttt{?draw\_errors} & \emph{undefined} & Logical &
	Whether to draw error bars for data points
	\\
	\hline
	\ttt{\$err\_options} & \ttt{""} & GAMELAN &
	Options for drawing the error bars
	\\
	\hline
	\ttt{?draw\_symbols} & \emph{undefined} & Logical &
	Whether to draw symbols at data points
	\\
	\hline
	\ttt{\$symbol} & Black dot & GAMELAN &
	Symbol to be drawn
	\\
	\hline
	\ttt{gmlcode\_bg} & \ttt{""} & GAMELAN &
	Code to be executed before drawing
	\\
	\hline
	\ttt{gmlcode\_fg} & \ttt{""} & GAMELAN &
	Code to be executed after drawing
	\\
	\hline
	\end{tabular}
	\end{center}
	\end{table}


	\section{Drawing options}

	The options for coloring lines, filling curves, or choosing line styles make
	use of macros in the GAMELAN language. At this place, we do not intend to
	give a full account of the possiblities, but we rather list a few basic
	features that are likely to be useful for drawing graphs.


	\subsubsection{Colors}

	GAMELAN knows about basic colors identified by name:
	\begin{center}
	\ttt{black}, \ttt{white}, \ttt{red}, \ttt{green}, \ttt{blue}, \ttt{cyan},
	\ttt{magenta}, \ttt{yellow}
	\end{center}
	More generically, colors in GAMELAN are RGB triplets of numbers (actually,
	numeric expressions) with values between 0 and 1, enclosed in brackets:
	\begin{center}
	\ttt{(\emph{r}, \emph{g}, \emph{b})}
	\end{center}

	To draw an object in color, one should apply the construct \ttt{withcolor
	\emph{color}} to its drawing code. The default color is always black.
	Thus, this will make a plot drawn in blue:
	\begin{quote}
	\begin{footnotesize}
	\ttt{\$draw\_options = "withcolor blue"}
	\end{footnotesize}
	\end{quote}
	and this will fill the drawing area of some histogram with an RGB color:
	\begin{quote}
	\begin{footnotesize}
	\ttt{\$fill\_options = "withcolor (0.8, 0.7, 1)"}
	\end{footnotesize}
	\end{quote}


	\subsubsection{Dashes}

	By default, lines are drawn continuously. Optionally, they can be drawn using
	a \emph{dash pattern}. Predefined dash patterns are
	\begin{center}
	\ttt{evenly}, \ttt{withdots}, \ttt{withdashdots}
	\end{center}
	Going beyond the predefined patterns, a generic dash pattern has the syntax
	\begin{center}
	\ttt{dashpattern (on \emph{l1} off \emph{l2} on} \ldots \ttt{)}
	\end{center}
	with an arbitrary repetition of \ttt{on} and \ttt{off} clauses. The numbers
	\ttt{\emph{l1}}, \ttt{\emph{l2}}, \ldots\ are lengths measured in pt.

	To apply a dash pattern, the option syntax \ttt{dashed \emph{dash-pattern}}
	should be used. Options strings can be concatenated. Here is how to draw in
	color with dashes:
	\begin{quote}
	\begin{footnotesize}
	\ttt{\$draw\_options = "withcolor red dashed evenly"}
	\end{footnotesize}
	\end{quote}
	and this draws error bars consisting of intermittent dashes and
	dots:
	\begin{quote}
	\begin{footnotesize}
	\ttt{\$err\_options = "dashed (withdashdots scaled 0.5)"}
	\end{footnotesize}
	\end{quote}
	The extra brackets ensure that the scale factor $1/2$ is applied only the dash
	pattern.


	\subsubsection{Hatching}

	Areas (e.g., below a histogram) can be filled with plain colors by the
	\ttt{withcolor} option. They can also be hatched by stripes, optionally
	rotated by some angle. The syntax is completely analogous to dashes. There
	are two predefined \emph{hatch patterns}:
	\begin{center}
	\ttt{withstripes}, \ttt{withlines}
	\end{center}
	and a generic hatch pattern is written
	\begin{center}
	\ttt{hatchpattern (on \emph{w1} off \emph{w2} on} \ldots \ttt{)}
	\end{center}
	where the numbers \ttt{\emph{l1}}, \ttt{\emph{l2}}, \ldots\ determine the
	widths of the stripes, measured in pt.

	When applying a hatch pattern, the pattern may be rotated by some angle (in
	degrees) and scaled. This looks like
	\begin{quote}
	\begin{footnotesize}
	\ttt{\$fill\_options = "hatched (withstripes scaled 0.8 rotated 60)"}
	\end{footnotesize}
	\end{quote}


	\subsubsection{Smooth curves}

	Plot points are normally connected by straight lines. If data are acquired by
	statistical methods, such as Monte Carlo integration, this is usually
	recommended. However, if a plot is generated using an analytic mathematical
	formula, or with sufficient statistics to remove fluctuations, it might be
	appealing to connect lines by some smooth interpolation. GAMELAN can switch
	on spline interpolation by the specific drawing option \ttt{linked smoothly}.
	Note that the results can be surprising if the data points do have sizable
	fluctuations or sharp kinks.


	\subsubsection{Error bars}

	Plots and histograms can be drawn with error bars. For histograms, only
	vertical error bars are supported, while plot points can have error bars in
	$x$ and $y$ direction. Error bars are switched on by the \ttt{?draw\_errors}
	flag.

	There is an option to draw error bars with ticks: \ttt{withticks} and an
	alternative option to draw arrow heads: \ttt{witharrows}. These can be used
	in the \ttt{\$err\_options} string.


	\subsubsection{Symbols}

	To draw symbols at plot points (or histogram midpoints), the flag
	\ttt{?draw\_symbols} has to be switched on.

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{Fast Detector Simulation and External Analysis}
	\label{chap:ext_anal}

	Events from a Monte Carlo event generator are further used in an
	analysis, most often combined with a detector simulation. Event files
	from the generator are then classified whether they are (i) parton
	level (coming from the hard matrix element) for which mostly LHE or
	\hepmc\ event formats are used, particle level (after parton shower
	and hadronization) - usually in \hepmc\ or \lcio\ format -, or
	detector level objects. The latter is the realm of packages like
	\ROOT\ or specific software from the experimental software
	frameworks. While detailed experimental studies take into account the
	best-possible detector description in a so-called full simulation via
	\geant\ which takes several seconds per event, fast studies are made
	with parameterized fast detector simulations like in \delphes\ or
	\texttt{SGV}. In the following, we discuss the options to interface
	external packages for these purposes or to pipe events from
	\whizard\ to such external packages.

	%%%%%

	\section{Interfacing ROOT}
	\label{sec:root}

	One of the most distributed analysis framework is
	\ROOT~\cite{Brun:1997pa}. In \whizard\ for the moment there is no
	direct interface to the \ROOT\ framework. The easiest way to write
	out particle-level events in the \ROOT\ or \ttt{RootTree} format is to
	use \whizard's interface to \hepmcthree: this modern incarnation of
	the \hepmc\ format has different writer classes, where the writer
	class for \ROOT\ and \ttt{RootTree} files is supported by \whizard's
	\hepmcthree\ interface. For this to work, one only has to make sure
	that \hepmcthree\ has been built with \ROOT\ support, and that the
	\whizard\ \ttt{configure} has to detect the \ROOT\ setup on the
	computing environment. For more details cf. the installation
	section~\ref{sec:hepmc}. If this has been successfully linked, then
	\whizard\ can use its own \hepmcthree\ interface to write out
	\ROOT\ or \ttt{RootTree} formats.

	This can be done by setting the following options in the
	\sindarin\ files:
	\begin{code}
	$hepmc3_mode = "Root"
	\end{code}
	or
	\begin{code}
	$hepmc3_mode = "RootTree"
	\end{code}
	For more details cf.~the \ROOT\ manual and documentation therein.

	%%%%%

	\section{Interfacing RIVET}
	\label{sec:rivet}

	\rivet~\cite{Buckley:2010ar} is a very mighty analysis framework which
	has been developed to make experimental analyses from the LHC
	experiments available for non-collaboration members. It can be easily
	used to analyze events and produce high-quality plots for differential
	distributions and experimental observables. Since version
	3~\cite{Bierlich:2019rhm} there is now also a lot of functionality
	that comes very handy for plotting differential distributions at fixed
	order in NLO calculations, e.g. negative weights in bins or how to
	treat imperfectly balanced events and counterevents close to bin
	boundaries etc. For the moment, \whizard\ does not have a dedicated
	interface to \rivet, so the preferred method is to write out events,
	best in the \hepmc\ or \hepmcthree\ format and then read them into
	\rivet. A more sophisticated interface is foreseen for a future
	version of \whizard, while there are already development versions
	where \whizard\ detects all the \rivet\ infrastructure and
	libraries. But they are not yet used.

	For more details and practical examples cf.~the \rivet\ manual. This
	describes in detail especially the \rivet\ installation. A typical
	error that occurs on systems where no \ROOT\ is installed
	(cf.~Sec.~\ref{sec:root}) is the one these \ttt{Missing TPython.h}
	missing headers. Then \rivet\ can nevertheless be easily built without
	\ROOT\ support by setting
	\begin{code}
	--disable-root
	\end{code}
	in the \ttt{rivet-bootstrap} script. For an installation of \rivet\ it
	is favorable to include the location of the \rivet\ \python\ scripts
	in the \ttt{PYTHONPATH} environment variable. They can be accessed
	from the \rivet\ configuration script as
	\begin{code}
	<path_to_rivet-config>/rivet-config --pythonpath
	\end{code}
	If the \python\ path is not known within the environment variables,
	then one commonly encounters error like \ttt{No module named rivet} or
	\ttt{Import error: no module named yoda} when running \rivet\ scripts
	like e.g. \ttt{yodamerge}.

	If you use a \rivet\ version older than \ttt{v3.1.1} there is no
	support for \hepmcthree\ yet, so when using \hepmcthree\ with
	\whizard\ please use the backwards compatibility mode of \hepmcthree
	in the \sindarin\ file:
	\begin{code}
	$hepmc3_mode = "HepMC2"
	\end{code}
	When using MPI parallelized runs of \whizard\ there will a large
	number of different \ttt{.hepmc} files (also if some grid architecture
	has produced these event files in junks). Then one has to first merge
	these event files.

	Here, we quickly explain how to steer \rivet\ for your own
	analysis. For more details, please confer the \rivet\ manual.
	\begin{enumerate}
	\item The command
	\begin{code}
	rivet-mkanalysis <name>
	\end{code}
	creates a template \rivet\ plugin for the analysis \ttt{<name>.cc},
	a template info file \ttt{<name>.info} amd a template file for the
	plot generation \ttt{<name>.plot}. Note that this overwrites
	potentially existing files in this folder with the same name.

	\item
	Now, analysis statements like e.g. cuts etc. can be implemented in
	\ttt{<name>.cc}. For analysis of parton-level events without parton
	showering, the cuts can be equivalent to those in \whizard, i.e. the
	generator-level cuts can be as strict as the analysis cuts to avoid
	generating unnecessary events. If parton showering is applied it is
	better to have looser generator than analysis cuts to avoid
	undesired plot artifacts.

	\item
	Next, one executes the command (the shared library name might be
	different e.g. on Darwin or BSD OS)
	\begin{code}
	rivet-buildplugin Rivet<name>.so <name>.cc
	\end{code}
	This creates an executable \rivet\ analysis library
	\ttt{Rivet<name>.so}. The custom analysis should now appear in the
	output of
	\begin{code}
	rivet --list <name>
	\end{code}
	If this is not the case, the analysis path has to be exported first
	as \ttt{RIVET\_ANALYSIS\_PATH=\$PWD}.

	\item
	We are now ready to use the custom analysis to analyze the
	\ttt{.hepmc} events by executing the command
	\begin{code}
	rivet --pwd --analysis=<name> -o <outfile>.yoda <path/to/hepmcfiles>
	\end{code}
	and save the produced histograms of the analysis in the \ttt{.yoda}
	format. In general the option \ttt{--ignore-beams} for
	\rivet\ should be used to prevent \rivet\ to stumble over beam
	remnants. This is also relevant for lepton collider processes with
	electron PDFs. For a large number of events, event files can become
	very big. To avoid writing them all on disk, a FIFO for the
	\ttt{<path/to/hepmcfiles>} can be used.

	\item
	Different \ttt{yoda} files can now be merged into a single file
	using the command
	\begin{code}
	<yodamerge --add -o <name>_full.yoda <name>_01.yoda ...
	\end{code}
	This should be applied e.g. for the case of fixed-order NLO
	differential distributions where Born, real and virtual components
	have been generated separately.

	\item
	Finally, plots can be produced: after listing all the histograms to
	be plotted in the plot file \ttt{<name>.plot}, the command
	\begin{code}
	rivet-mkhtml <name>_full.yoda
	\end{code}
	translates the \ttt{.yoda} file into a histogram file in the
	\ttt{.dat} format. These plots can either be visually enhanced by
	modifying the \ttt{<name>.plot} file as is described on the webpage
	\url{https://rivet.hepforge.org/make-plots.html}, or by using any
	other external plotting tool like e.g. \ttt{Gnuplot} for the
	\ttt{.dat} files.

	\end{enumerate}

	Clearly, this gives only a rough sketch on how to use \rivet\ for an
	analysis. For more details, please consult the \rivet\ webpage and the
	\rivet\ manual.

	%%%%%

	\vspace{1cm}

	\section{Fast Detector Simulation with DELPHES}
	\label{sec:delphes}

	Fast detector simulation allows relatively quick checks whether
	experimental analyses actually work in a semi-realistic detector
	study. There are some older tools for fast simulation like
	e.g.~\ttt{PGS} (which is no longer actively maintained) and \ttt{SGV}
	which is default fast simulation for ILC studies. For LHC and general
	future hadron collider studies, \delphes~\cite{deFavereau:2013fsa} is
	the most commonly used tool for fast detector simulation.

	The details on how to obtain and build \delphes\ can be obtained from
	their webpage, \url{https://cp3.irmp.ucl.ac.be/projects/delphes}. It
	depends both on~\ttt{Tcl/Tk} as well as
	\ROOT~(cf. Sec.~\ref{sec:root}. Interfacing any Monte Carlo event
	generator with a fast detector simulation like \delphes\ is rather
	trivial: \delphes\ ships with up to five executables
	\begin{code}
	DelphesHepMC
	DelphesLHEF
	DelphesPythia8
	DelphesROOT
	DelphesSTDHEP
	\end{code}
	\ttt{DelphesPythia8} is a direct interface between \pythiaeight\ and
	\delphes, so detector-level events are directly produced via an API
	interface between \pythiaeight\ and \delphes. This is the most
	convenient method which is foreseen for \whizard, however not yet
	implemented. The other four binaries take input files in the \hepmc,
	LHE, \stdhep\ and \ROOT\ format, apply a fast detector simulation
	according to the chosen input file and give a \ROOT\ detector-level
	event file as output.

	Executing one of the binaries above without options, the following
	message will be displayed:
	\begin{code}
	./DelphesHepMC
	Usage: DelphesHepMC config_file output_file [input_file(s)]
	config_file - configuration file in Tcl format,
	output_file - output file in ROOT format,
	input_file(s) - input file(s) in HepMC format,
	with no input_file, or when input_file is -, read standard input.
	\end{code}
	Using \delphes\ with \hepmc\ event files then works as
	\begin{code}
	./DelphesHepMC cards/delphes_card_ATLAS.tcl output.root input.hepmc
	\end{code}
	For \stdhep\ files which are directly by \whizard\ without external
	packages (only assuming that the XDR C libraries are present on the
	system), execute
	\begin{code}
	./DelphesSTDHEP cards/delphes_card_ILD.tcl delphes_output.root input.hep
	\end{code}
	For LHE files as input, use
	\begin{code}
	./DelphesLHEF cards/delphes_card_CLICdet_Stage1.tcl delphes_output.root input.lhef
	\end{code}
	and for \ROOT\ (particle-level) files use
	\begin{code}
	./DelphesROOT cards/delphes_card_CMS.tcl delphes_output.root input.root
	\end{code}
	In the \delphes\ cards directory, there is a long list of supported
	input files for existing and future detectors, a few of which we have
	displayed here.

	\delphes\ detector-level output files can then be analyzed with
	\ROOT\ as described in the \delphes\ manual.

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{User Interfaces for WHIZARD}
	\label{chap:userint}

	\section{Command Line and \sindarin\ Input Files}
	\label{sec:cmdline-options}

	The standard way of using \whizard\ involves a command script written
	in \sindarin. This script is executed by \whizard\ by mentioning it
	on the command line:
	\begin{interaction}
	whizard script-name.sin
	\end{interaction}
	You may specify several script files on the command line; they will be
	executed consecutively.

	If there is no script file, \whizard\ will read commands from standard
	input. Hence, this is equivalent:
	\begin{interaction}
	cat script-name.sin \| whizard
	\end{interaction}

	When executed from the command line, \whizard\ accepts several options.
	They are given in long form, i.e., they begin with two dashes. Values
	that belong to options follow the option string, separated either by
	whitespace or by an equals sign. Hence, \ttt{--prefix /usr} and
	\ttt{--prefix=/usr} are equivalent. Some options are also available
	in short form, a single dash with a single letter. Short-form options
	can be concatenated, i.e., a dash followed by several option letters.

	The first set of options is intended for normal operation.
	\begin{description}
	\item[\ttt{--debug AREA}]: Switch on debug output for \ttt{AREA}.
	\ttt{AREA} can be one of \whizard's source directories or \ttt{all}.
	\item[\ttt{--debug2 AREA}]: Switch on more verbose debug output for \ttt{AREA}.
	\item[\ttt{--single-event}]: Only compute one phase-space point (for debugging).
	\item[\ttt{--execute COMMANDS}]: Execute \ttt{COMMANDS} as a script
	before the script file (see below). Short version: \ttt{-e}
	\item[\ttt{--file CMDFILE}]: Execute commands in \ttt{CMDFILE} before the
	main script file (see below). Short version: \ttt{-f}
	\item[\ttt{--help}]: List the available options and exit. Short version:
	\ttt{-h}
	\item[\ttt{--interactive}]: Run \whizard\ interactively. See
	Sec.~\ref{sec:whish}. Short version: \ttt{-i}.
	\item[\ttt{--library LIB}]: Preload process library \ttt{LIB}
	(instead of the default \ttt{processes}). Short version: \ttt{-l}.
	\item[\ttt{--localprefix DIR}]: Search in \ttt{DIR} for local
	models. Default is \ttt{\$HOME/.whizard}.
	\item[\ttt{--logfile \ttt{FILE}}]: Write log to \ttt{FILE}. Default is
	\ttt{whizard.log}. Short version: \ttt{-L}.
	\item[\ttt{--logging}]: Start logging on startup (default).
	\item[\ttt{--model MODEL}]: Preload model \ttt{MODEL}. Default is the
	Standard Model \ttt{SM}. Short version: \ttt{-m}.
	\item[\ttt{--no-banner}]: Do not display banner at startup.
	\item[\ttt{--no-library}]: Do not preload a library.
	\item[\ttt{--no-logfile}]: Do not write a logfile.
	\item[\ttt{--no-logging}]: Do not issue information into the logfile.
	\item[\ttt{--no-model}]: Do not preload a specific physics model.
	\item[\ttt{--no-rebuild}]: Do not force a rebuild.
	\item[\ttt{--query VARIABLE}]: Display documentation of \ttt{VARIABLE}.
	Short version: \ttt{-q}.
	\item[\ttt{--rebuild}]: Do not preload a process library and do all
	calculations from scratch, even if results exist. This combines all
	rebuild options. Short version: \ttt{-r}.
	\item[\ttt{--rebuild-library}]: Rebuild the process library, even if code
	exists.
	\item[\ttt{--rebuild-phase-space}]: Rebuild the phase space setup, even if
	it exists.
	\item[\ttt{--rebuild-grids}]: Redo the integration, even if previous grids
	and results exist.
	\item[\ttt{--rebuild-events}]: Redo event generation, discarding previous
	event files.
	\item[\ttt{--show-config}]: Show build-time configuration.
	\item[\ttt{--version}]: Print version information and exit. Short version:
	\ttt{-V}.
	\item[-]: Any further options are interpreted as file names.
	\end{description}
	The second set of options refers to the configuration. They are
	relevant when dealing with a relocated \whizard\ installation, e.g.,
	on a batch systems.
	\begin{description}
	\item[\ttt{--prefix DIR}]: Specify the actual location of the \whizard\
	installation, including all subdirectories.
	\item[\ttt{--exec-prefix DIR}]: Specify the actual location of the
	machine-specific parts of the \whizard\ installation (rarely needed).
	\item[\ttt{--bindir DIR}]: Specify the actual location of the
	executables contained in the \whizard\ installation (rarely needed).
	\item[\ttt{--libdir DIR}]: Specify the actual location of the
	libraries contained in the \whizard\ installation (rarely needed).
	\item[\ttt{--includedir DIR}]: Specify the actual location of the
	include files contained in the \whizard\ installation (rarely needed).
	\item[\ttt{--datarootdir DIR}]: Specify the actual location of the
	data files contained in the \whizard\ installation (rarely needed).
	\item[\ttt{--libtool LOCAL\_LIBTOOL}]: Specify the actual location and
	name of the \ttt{libtool} script that should be used by \whizard.
	\item[\ttt{--lhapdfdir DIR}]: Specify the actual location and
	of the \lhapdf\ installation that should be used by \whizard.
	\end{description}

	The \ttt{--execute} and \ttt{--file} options allow for fine-tuning the command
	flow. The \whizard\ main program will concatenate all commands given in
	\ttt{--execute} commands together with all commands contained in \ttt{--file}
	options, in the order they are encountered, as a contiguous command stream
	that is executed \emph{before} the main script (in the example above,
	\ttt{script-name.sin}).

	Regarding the \ttt{--execute} option, commands that contain blanks must be
	enclosed in matching single- or double-quote characters since the individual
	tokens would otherwise be intepreted as separate option strings.
	Unfortunately, a Unix/Linux shell interpreter will strip quotes before handing
	the command string over to the program. In that situation, the
	quote-characters must be quoted themselves, or the string must be enclosed in
	quotes twice. Either version should work as a command line interpreted by
	the shell:
	\begin{interaction}
	whizard --execute \'int my_flag = 1\' script-name.sin
	whizard --execute "'int my_flag = 1'" script-name.sin
	\end{interaction}


	\section{WHISH -- The \whizard\ Shell/Interactive mode}
	\label{sec:whish}

	\whizard\ can be also run in the interactive mode using its own shell
	environment. This is called the \whizard\ Shell (WHISH). For this
	purpose, one starts with the command
	\begin{interaction}
	/home/user$ whizard --interactive
	\end{interaction}
	or
	\begin{interaction}
	/home/user$ whizard -i
	\end{interaction}
	\whizard\ will preload the Standard Model and display a command
	prompt:
	\begin{interaction}
	whish?
	\end{interaction}
	You now can enter one or more \sindarin\ commands, just as if they
	were contained in a script file. The commands are compiled and
	executed after you hit the ENTER key. When done, you get a new
	prompt. The WHISH can be closed by the \ttt{quit} command:
	\begin{verbatim}
	whish? quit
	\end{verbatim}
	Obviously, each input must be self-contained: commands must be
	complete, and conditionals or scans must be closed on the same line.

	If \whizard\ is run without options and without a script file, it
	also reads commands interactively, from standard input. The
	difference is that in this case, interactive input is multi-line,
	terminated by \ttt{Ctrl-D}, the script is then compiled and
	executed as a whole, and \whizard\ terminates.

	In WHISH mode, each input line is compiled and executed individually.
	Furthermore, fatal errors are masked, so in case of error the program
	does not terminate but returns to the WHISH command line. (The
	attempt to recover may fail in some circumstances, however.)


	\section{Graphical user interface}

	\emph{This is still experimental.}

	\whizard\ ships with a graphical interface that can be steered in a
	browser of your choice. It is located in \ttt{share/gui}. To use it,
	you have to run \ttt{npm install} (which will install javascript
	libraries locally in that folder) and \ttt{npm start} (which will start
	a local web server on your machine) in that folder. More technical
	details and how to get \ttt{npm} is discussed in
	\ttt{share/gui/README.md}. When it is running, you can access the GUI
	by entering \ttt{localhost:3000} as address in your browser. The GUI is
	separated into different tabs for basic settings, integration,
	simulation, cuts, scans, NLO and beams. You can select and enter what
	you are interested in and the GUI will produce a \sindarin\ file. You
	can use the GUI to run WHIZARD with that \sindarin\ or just produce it
	with the GUI and then tweak it further with an editor. In case you run
	it in the GUI, the log file will be updated in the browser as it is
	produced. Any \sindarin\ features that are not supported by the GUI can
	be added directly as "Additional Code".

	\section{\whizard\ as a library}

	The compiled \whizard\ program consists of two libraries (\ttt{libwhizard} and
	\ttt{libomega}). In the standard setup, these are linked to a short main
	program which deals with command line options and top-level administration.
	This is the stand-alone \ttt{whizard} executable program.

	Alternatively, it is possible to link the libraries to a different main
	program of the user's choice. The user program can take complete control of
	the \whizard\ features. The \ttt{libwhizard} library provides an API, a
	well-defined set of procedures which can be called from a foreign main
	program. The supported languages are \fortran, \ttt{C}, and \cpp.
	Using the C API, any other language which supports linking against C
	libraries can also be interfaced.

	\subsection{Fortran main program}

	To link a \fortran\ main program with the \whizard\ library, the following steps
	must be performed:
	\begin{enumerate}
	\item
	Configure, build and install \whizard\ as normal.
	\item
	Include code for accessing \whizard\ functionality in the user program.
	The code should initialize
	\whizard, execute the intended commands, and finalize. For an example, see
	below.
	\item
	Compile the user program. The user program must be
	compiled with the same \fortran\ compiler that has been used for the \whizard\
	build.

	If necessary, specify an option that finds the
	installed \whizard\ module files.
	For instance, if \whizard\ has been installed in \ttt{whizard-path}, this
	should read
	\begin{code}
	-Iwhizard-path/lib/mod/whizard
	\end{code}
	\item
	Link the program (or compile-link in a single step). If necessary, specify
	options that find the installed \whizard\ and \oMega\ libraries. For
	instance, if \whizard\ has been installed in \ttt{whizard-path}, this should
	read
	\begin{code}
	-Lwhizard-path/lib -lwhizard -lwhizard_prebuilt -lomega
	\end{code}
	On some systems, you may have to replace \ttt{lib} by \ttt{lib64}.

	Such an example compile-link could look like
	\begin{code}
	gfortran manual_example_api.f90 -Lwhizard-path/lib -lwhizard -lwhizard_prebuilt -lomega
	\end{code}

	If \whizard\ has been compiled with a non-default \fortran\ compiler, you may
	have to explicitly link the appropriate \fortran\ run-time libraries.

	The \ttt{tirpc} library is used by the \ttt{StdHEP} subsystem for \ttt{xdr}
	functionality. This library should be present on the host
	system. This library needs only be linked of the SunRPC library is
	not installed on the system.

	If additional libraries such as
	\hepmc\ are enabled in the \whizard\ configuration, it may be necessary to
	provide extra options for linking those.

	An example here looks like
	\begin{code}
	gfortran manual_example_api.f90 -Lwhizard-path/lib -lwhizard
	-lwhizard_prebuilt -lomega -lHepMC3 -lHepMC3rootIO -llcio
	\end{code}

	\item
	Run the program. If necessary, provide the path to the installed shared
	libraries. For instance, if \whizard\ has been installed in
	\ttt{whizard-path}, this should read
	\begin{code}
	export LD_LIBRARY_PATH="whizard-path/lib:$LD_LIBRARY_PATH"
	\end{code}
	On some systems, you may have to replace \ttt{lib} by \ttt{lib64}, as above.

	The \whizard\ subsystem will work with input and output
	files in the current working directory, unless asked to do otherwise.
	\end{enumerate}
	Below is an example program, adapted from \whizard's internal unit-test suite.
	The user program controls the \whizard\ workflow in the same way as a
	\sindarin\ script would do. The commands are a mixture of \sindarin\ command
	calls and functionality for passing information between the \whizard\
	subsystem and the host program.
	In particular, the program can process generated events one-by-one.
	\begin{code}
	program main

	! WHIZARD API as a module
	use api

	! Standard numeric types
	use iso_fortran_env, only: real64, int32

	implicit none

	! WHIZARD and event-sample objects
	type(whizard_api_t) :: whizard
	type(simulation_api_t) :: sample

	! Local variables
	real(real64) :: integral, error
	real(real64) :: sqme, weight
	integer(int32) :: idx
	integer(int32) :: i, it_begin, it_end

	! Initialize WHIZARD, setting some global option
	call whizard%option ("model", "QED")
	call whizard%init ()

	! Define a process, set some variables
	call whizard%command ("process mupair = e1, E1 => e2, E2")
	call whizard%set_var ("sqrts", 100._real64)
	call whizard%set_var ("seed", 0)

	! Generate matrix-element code, integrate and retrieve result
	call whizard%command ("integrate (mupair)")
	call whizard%get_integration_result ("mupair", integral, error)

	! Print result
	print 1, "cross section =", integral / 1000, "pb"
	print 1, "error =", error / 1000, "pb"
	1 format (2x,A,1x,F5.1,1x,A)
	2 format (2x,A,1x,L1)

	! Settings for event generation
	call whizard%set_var ("$sample", "mupair_events")
	call whizard%set_var ("n_events", 2)

	! Create an event-sample object and generate events
	call whizard%new_sample ("mupair", sample)
	call sample%open (it_begin, it_end)
	do i = it_begin, it_end
	call sample%next_event ()
	call sample%get_event_index (idx)
	call sample%get_weight (weight)
	call sample%get_sqme (sqme)
	print "(A,I0)", "Event #", idx
	print 3, "sqme =", sqme
	print 3, "weight =", weight
	3 format (2x,A,1x,ES10.3)
	end do

	! Finalize the event-sample object
	call sample%close ()

	! Finalize the WHIZARD object
	call whizard%final ()

	end program main
	\end{code}
	The API provides the following commands as \fortran\ subroutines. Most of them
	are used in the example above.

	\subsubsection{Module}
	There is only one module from the \whizard\ package which must be
	\texttt{use}d by the user program:
	\begin{quote}
	\tt use api
	\end{quote}
	You may \texttt{use} any other \whizard\ module in our program, all module
	files are part of the installation. Be aware,
	however, that all other modules are considered internal. Unless explictly
	mentioned in this manual, interfaces are
	not documented here and may change between versions.

	Changes to the \ttt{api} module, if any, will be documented here.

	\subsubsection{Master object}
	All functionality is accessed via a master API object which should be declared
	as follows:
	\begin{quote}
	\tt type(whizard\_api\_t) :: whizard
	\end{quote}
	There should be only one master object.

	\subsubsection{Pre-Initialization options}
	Before initializing the API object, it is possible to provide options. The
	available options mirror the command-line options of the stand-alone program,
	cf.\ Sec.~\ref{sec:cmdline-options}.
	\begin{quote}
	\tt call whizard\%option (\textit{key}, \textit{value})
	\end{quote}
	All keys and values are \fortran\ character strings. The following options are
	available. For all options, default values exist as listed in
	Sec.~\ref{sec:cmdline-options}.
	\begin{description}
	\item[\tt model] Model that should be preloaded.
	\item[\tt library] Name of the library where matrix-element code should end up.
	\item[\tt logfile] Name of the logfile that \whizard\ will write.
	\item[\tt job\_id] Name of the current job; can be used for writing unique output
	files.
	\item[\tt unpack] Comma-separated list of files to be uncompressed and unpacked
	(via \ttt{tar} and \ttt{gzip}) when \ttt{init} is called on the API object.
	\item[\tt pack] Comma-separated list of files or directories to be packed and
	compressed when \ttt{final} is called.
	\item[\tt rebuild] All of the following:
	\item[\tt rebuild\_library] Force rebuilding a matrix-element code library,
	overwriting results from a previous run.
	\item[\tt recompile] Force recompiling the matrix-element code library.
	\item[\tt rebuild\_grids] Force reproducing integration passes.
	\item[\tt rebuild\_events] Force regenerating event samples.
	\end{description}

	\subsubsection{Initialization and finalization}
	After options have been set, the system is initialized via
	\begin{quote}
	\tt call whizard\%init
	\end{quote}
	Once initialized, \whizard\ can execute commands as listed below. When this
	is complete, clean up by
	\begin{quote}
	\tt call whizard\%final
	\end{quote}

	\subsubsection{Variables and values}

	In the API, \whizard\ requires numeric data types according to the IEEE
	standard, which is available to \fortran\ in the \ttt{iso\_fortran\_env}
	intrinsic module. Strictly speaking, integer data must have type \ttt{int32},
	and real data must have type \ttt{real64}.

	For most systems and default compiler settings, it
	is not really necessary to \ttt{use} the ISO module and its data types.
	Integers map to default \fortran\ \ttt{integer},
	and real values map to default \fortran\ \ttt{double precision}.

	As an
	alternative, you may \ttt{use} the \whizard\ internal \ttt{kinds} module which
	declares a \ttt{real(default)} type
	\begin{quote}
	\tt use kinds, only: default
	\end{quote}
	On most systems, this will be equivalent
	to \ttt{real(real64)}.

	To set a \sindarin\ variable, use the function that corresponds to the data
	type:
	\begin{quote}
	\tt call whizard\%set\_var (\textit{name}, \textit{value})
	\end{quote}
	The name is a \fortran\ string which has to be equal to the name of the
	corresponding \sindarin\ variable, including any prefix character (\$ or ?).
	The value depends on the type of the \sindarin\
	variable.

	To retrieve the current value of a variable:
	\begin{quote}
	\tt call whizard\%get\_var (\textit{name}, \textit{var})
	\end{quote}
	The variable must be declared as \ttt{integer}, \ttt{real(real64)},
	\ttt{logical}, or
	\ttt{character(:), allocatable}. This depends on the \sindarin\ variable type.

	\subsubsection{Commands}
	Any \sindarin\ command can be called via
	\begin{quote}
	\tt call whizard\%command (\textit{command})
	\end{quote}
	\ttt{\it command} is a \fortran\ character string, as it would appear
	in a \sindarin\ script.

	This includes, in particular, the important commands \ttt{process},
	\ttt{integrate}, and \ttt{simulate}. You may also set variables that way.

	\subsubsection{Retrieving cross-section results}
	This call returns the results (integration and error) from a preceding
	integration run for the process \textit{process-name}:
	\begin{quote}
	\tt call whizard\%get\_integration\_result ("\textit{process-name}",
	integral, error)
	\end{quote}
	There is also an optional argument \ttt{known} of type \ttt{logical} which is
	set if the integration run was successful, so integral and error are
	meaningful.



	\subsubsection{Event-sample object}
	A \ttt{simulate} command will produce an event sample. With the appropriate
	settings, the sample will be written to file in any chosen format, to be
	post-processed when it is complete.

	However, a possible purpose of using the \whizard\ API is to process events one-by-one
	when they are generated. To this end, there is an event-sample handle, which
	can be declared in this way:
	\begin{quote}
	\tt type(simulation\_api\_t) :: sample
	\end{quote}
	An instance \ttt{sample} of this type is created by this factory method:
	\begin{quote}
	\tt call whizard\%new\_sample ("\textit{process-name(s)}", sample)
	\end{quote}
	The command accepts a comma-separated list of process names which should be
	included in the event sample.

	To start event generation for this sample, call
	\begin{quote}
	\tt call sample\%open (\textit{it\_begin}, \textit{it\_end} )
	\end{quote}
	where the two output parameters (integers) \ttt{\it it\_begin} and \ttt{\it it\_end}
	provide the bounds for an event loop in the calling program. (In serial mode,
	the bounds are equal to 1 and \ttt{n\_events}, respectively, but in an MPI
	parallel environment, they depend on the computing node.)

	This command generates a new event, to be enclosed within an event loop:
	\begin{quote}
	\tt call sample\%next\_event
	\end{quote}
	The event will be available by format-specific access methods, see below.

	This command closes and deletes an event sample after the event loop has
	completed:
	\begin{quote}
	\tt call sample\%close
	\end{quote}

	\subsubsection{Retrieving event data}

	After a call to \ttt{next\_event}, the sample object can be queried for
	specific event data.
	\begin{quote}
	\tt call sample\%get\_event\_index (\textit{value})
	\end{quote}
	returns the index (integer counter) of the current event.
	\begin{quote}
	\tt call sample\%get\_process\_index (\textit{value})
	\\
	\tt call sample\%get\_process\_id (\textit{value})
	\end{quote}
	returns the numeric (string) ID of the hard process, respectively, that was
	generated in this event. The variables must be declared as \ttt{integer} and
	\ttt{character(:), allocatable}, respectively.

	The following methods return \ttt{real(real64)} values.
	\begin{quote}
	\tt call sample\%get\_sqrts (\textit{value})
	\end{quote}
	returns the $\sqrt{s}$ value of this event.
	\begin{quote}
	\tt call sample\%get\_fac\_scale (\textit{value})
	\end{quote}
	returns the factorization scale of this event (\textit{value}).
	\begin{quote}
	\tt call sample\%get\_alpha\_s (\textit{value})
	\end{quote}
	returns the value of the strong coupling for this event (\textit{value}).
	\begin{quote}
	\tt call sample\%get\_sqme (\textit{value})
	\end{quote}
	returns the value of the squared matrix element (summed over final states and
	averaged over initial states).
	\begin{quote}
	\tt call sample\%get\_weight (\textit{value})
	\end{quote}
	returns the Monte-Carlo weight of this event.

	Access to the event record depends on the event format that has been
	selected. The format must allow access to individual events via data
	structures in memory. There are three cases where such structures exist and
	are accessible:
	\begin{enumerate}
	\item
	If the event format uses a COMMON block, event data is accessible
	via this COMMON block, which must be declared in the calling routine.
	\item
	The \hepmc\ event format communicates via a \cpp\ object. In \fortran, there
	is a wrapper which has to be declared as
	\begin{quote}
	\tt type(hepmc\_event\_t) :: hepmc\_event
	\end{quote}
	To activate this handle, the \ttt{next\_event} call must reference it as
	an argument:
	\begin{quote}
	\tt call sample\%next\_event (hepmc\_event)
	\end{quote}
	The \whizard\ module \ttt{hepmc\_interface} contains procedures which can
	work with this record. A pointer to the actual \cpp\ object can be retrieved
	as a \fortran\
	\ttt{c\_ptr} object as follows:
	\begin{quote}
	\tt
	type(c\_ptr) :: hepmc\_ptr
	\\
	\dots
	\\
	hepmc\_ptr = hepmc\_event\_get\_c\_ptr (hepmc\_event)
	\end{quote}
	\item
	The \lcio\ event format also communicates via a \cpp\ object. The access
	methods are entirely analogous, replacing \ttt{hepmc} by \ttt{lcio} in all
	calls and names.
	\end{enumerate}


	\subsection{C main program}
	To link a C main program with the \whizard\ library, the following steps
	must be performed:
	\begin{enumerate}
	\item
	Configure, build and install \whizard\ as normal.
	\item
	Include code for accessing \whizard\ functionality in the user program.
	The code should initialize
	\whizard, execute the intended commands, and finalize. For an example, see
	below.
	\item
	Compile the user program with the option that finds the WHIZARD \ttt{C/C++}
	interface header file.
	For instance, if \whizard\ has been installed in \ttt{whizard-path}, this
	should read
	\begin{code}
	-Iwhizard-path/include
	\end{code}
	\item
	Link the program with the necessary libraries (or compile-link in a single
	step). If
	\whizard\ has been installed in a system path, this should work
	automatically. If
	\whizard\ has been installed in a non-default \ttt{whizard-path}, these
	are the options:
	\begin{code}
	-Lwhizard-path/lib -lwhizard -lwhizard_prebuilt -lomega -ltirpc
	\end{code}
	On some systems, you may have to replace \ttt{lib} by \ttt{lib64}.

	If \whizard\ has been compiled with a non-default \fortran\ compiler, you may
	have to explicitly link the appropriate \fortran\ run-time libraries.

	The \ttt{tirpc} library is used by the \ttt{StdHEP} subsystem for \ttt{xdr}
	functionality. This library should be present on the host
	system. Cf. the corresponding remarks in the section for a
	\fortran\ main program.

	If additional libraries such as
	\hepmc\ are enabled in the \whizard\ configuration, it may be necessary to
	provide extra options for linking those.

	\item
	Run the program. If necessary, provide the path to the installed shared
	libraries. For instance, if \whizard\ has been installed in
	\ttt{whizard-path}, this should read
	\begin{code}
	export LD_LIBRARY_PATH="whizard-path/lib:$LD_LIBRARY_PATH"
	\end{code}
	On some systems, you may have to replace \ttt{lib} by \ttt{lib64}, as above.

	The \whizard\ subsystem will work with input and output
	files in the current working directory, unless asked to do otherwise.
	\end{enumerate}
	Below is an example program, adapted from \whizard's internal unit-test suite.
	The user program controls the \whizard\ workflow in the same way as a
	\sindarin\ script would do. The commands are a mixture of \sindarin\ command
	calls and functionality for passing information between the \whizard\
	subsystem and the host program.
	In particular, the program can process generated events one-by-one.
	\begin{code}
	#include <stdio.h>
	#include "whizard.h"

	int main( int argc, char* argv[] )
	{
	/* WHIZARD and event-sample objects */
	void* wh;
	void* sample;

	/* Local variables */
	double integral, error;
	double sqme, weight;
	int idx;
	int it, it_begin, it_end;

	/* Initialize WHIZARD, setting some global option */
	whizard_create( &wh );
	whizard_option( &wh, "model", "QED" );
	whizard_init( &wh );

	/* Define a process, set some variables */
	whizard_command( &wh, "process mupair = e1, E1 => e2, E2" );
	whizard_set_double( &wh, "sqrts", 10. );
	whizard_set_int( &wh, "seed", 0 );

	/* Generate matrix-element code, integrate and retrieve result */
	whizard_command( &wh, "integrate (mupair)" );

	/* Print result */
	whizard_get_integration_result( &wh, "mupair", &integral, &error);
	printf( " cross section = %5.1f pb\n", integral / 1000. );
	printf( " error = %5.1f pb\n", error / 1000. );

	/* Settings for event generation */
	whizard_set_char( &wh, "$sample", "mupair_events" );
	whizard_set_int( &wh, "n_events", 2 );

	/* Create an event-sample object and generate events */
	whizard_new_sample( &wh, "mupair", &sample );
	whizard_sample_open( &sample, &it_begin, &it_end );
	for (it=it_begin; it<=it_end; it++) {
	whizard_sample_next_event( &sample );
	whizard_sample_get_event_index( &sample, &idx );
	whizard_sample_get_weight( &sample, &weight );
	whizard_sample_get_sqme( &sample, &sqme );
	printf( "Event #%d\n", idx );
	printf( " sqme = %10.3e\n", sqme );
	printf( " weight = %10.3e\n", weight );
	}

	/* Finalize the event-sample object */
	whizard_sample_close( &sample );

	/* Finalize the WHIZARD object */
	whizard_final( &wh );
	}
	\end{code}

	\subsubsection{Header}
	The necessary declarations are imported by the directive
	\begin{quote}
	\tt \#include "whizard.h"
	\end{quote}

	\subsubsection{Master object}
	All functionality is accessed via a master API object which should be declared
	as a \ttt{void*} pointer:
	\begin{quote}
	\tt void* wh;
	\end{quote}
	The object must be explicitly created:
	\begin{quote}
	\tt whizard\_create( \&wh );
	\end{quote}
	There should be only one master object.

	\subsubsection{Pre-Initialization options}
	Before initializing the API object, it is possible to provide options. The
	available options mirror the command-line options of the stand-alone program,
	cf.\ Sec.~\ref{sec:cmdline-options}.
	\begin{quote}
	\tt whizard\_option( \&wh, \textit{key}, \textit{value} );
	\end{quote}
	All keys and values are null-terminated C character strings. The available
	options are
	listed above in the \fortran\ interface documentation.

	\subsubsection{Initialization and finalization}
	After options have been set, the system is initialized via
	\begin{quote}
	\tt whizard\_init( \&wh );
	\end{quote}
	Once initialized, \whizard\ can execute commands as listed below. When this
	is complete, clean up by
	\begin{quote}
	\tt whizard\_final( \&wh );
	\end{quote}

	\subsubsection{Variables and values}

	In the API, \whizard\ requires numeric data types according to the IEEE
	standard. Integers map to C \ttt{int}, and real values map to C
	\ttt{double}. Logical values map to C \ttt{int} interpreted as \ttt{bool},
	and string values map to null-terminated C strings.

	To set a \sindarin\ variable of appropriate type:
	\begin{quote}
	\tt whizard\_set\_int ( \&wh, \textit{name}, \textit{value} );
	\\
	\tt whizard\_set\_double ( \&wh, \textit{name}, \textit{value} );
	\\
	\tt whizard\_set\_bool ( \&wh, \textit{name}, \textit{value} );
	\\
	\tt whizard\_set\_char ( \&wh, \textit{name}, \textit{value} );
	\end{quote}
	\textit{name} is declared \ttt{const char*}. It must match the corresponding
	\sindarin\ variable name, including any prefix character (\$ or ?).
	\textit{value} is declared \ttt{const double/int/char*}.

	To retrieve the current value of a variable:
	\begin{quote}
	\tt whizard\_get\_int ( \&wh, \textit{name}, \&\textit{var} );
	\\
	\tt whizard\_get\_double ( \&wh, \textit{name}, \&\textit{var} );
	\\
	\tt whizard\_get\_bool ( \&wh, \textit{name}, \&\textit{var} );
	\\
	\tt whizard\_get\_char ( \&wh, \textit{name}, \textit{var}, \textit{len} );
	\end{quote}
	Here, \ttt{\it var} is a C variable of appropriate type. In the character
	case, \ttt{\it var} is a C character array declared as
	\ttt{\it var}[\ttt{\it len}]. The functions return zero if the \sindarin\
	variable has a known value.

	\subsubsection{Commands}
	Any \sindarin\ command can be called via
	\begin{quote}
	\tt whizard\_command( \&wh, \textit{command} );
	\end{quote}
	\ttt{\it command} is a null-terminated C string that contains commands as they
	would appear in a \sindarin\ script.

	This includes, in particular, the important commands \ttt{process},
	\ttt{integrate}, and \ttt{simulate}. You may also set variables that way.

	\subsubsection{Retrieving cross-section results}
	This call returns the results (integration and error) from a preceding
	integration run for the process \textit{process-name}:
	\begin{quote}
	\tt whizard\_get\_integration\_result( \&wh, "\textit{process-name}",
	\&\textit{integral}, \&\textit{error})
	\end{quote}
	\ttt{\it integral} and \ttt{\it error} are C variables of type \ttt{double}.
	The function returns zero if the integration run was successful, so integral
	and error are meaningful.

	\subsubsection{Event-sample object}
	A \ttt{simulate} command will produce an event sample. With the appropriate
	settings, the sample will be written to file in any chosen format, to be
	post-processed when it is complete.

	However, a possible purpose of using the \whizard\ API is to process events one-by-one
	when they are generated. To this end, there is an event-sample handle, which
	can be declared in this way:
	\begin{quote}
	\tt void* \textit{sample};
	\end{quote}
	An instance \ttt{\it sample} of this type is created by this factory method:
	\begin{quote}
	\tt whizard\_new\_sample( \&wh, "\textit{process-name(s)}", \&\textit{sample});
	\end{quote}
	The command accepts a comma-separated list of process names which should be
	included in the event sample.

	To start event generation for this sample, call
	\begin{quote}
	\tt whizard\_sample\_open( \&\textit{sample}, \&\textit{it\_begin},
	\&\textit{it\_end} );
	\end{quote}
	where the two output variables (\ttt{int}) \ttt{\it it\_begin} and
	\ttt{\it it\_end}
	provide the bounds for an event loop in the calling program. (In serial mode,
	the bounds are equal to 1 and \ttt{n\_events}, respectively, but in an MPI
	parallel environment, they depend on the computing node.)

	This command generates a new event, to be enclosed within an event loop:
	\begin{quote}
	\tt whizard\_sample\_next\_event( \&\textit{sample} );
	\end{quote}
	The event will be available by format-specific access methods, see below.

	This command closes and deletes an event sample after the event loop has
	completed:
	\begin{quote}
	\tt whizard\_sample\_close( \&\textit{sample} );
	\end{quote}

	\subsubsection{Retrieving event data}

	After a call to \ttt{whizard\_sample\_next\_event}, the sample object can be
	queried for specific event data.
	\begin{quote}
	\tt whizard\_sample\_get\_event\_index( \&\textit{sample}, \&\textit{value} );
	\\
	\tt whizard\_sample\_get\_process\_index( \&\textit{sample}, \&\textit{value} );
	\\
	\tt whizard\_sample\_get\_process\_id( \&\textit{sample}, \textit{value}, \textit{len} );
	\\
	\tt whizard\_sample\_get\_sqrts( \&\textit{sample}, \&\textit{value} );
	\\
	\tt whizard\_sample\_get\_fac\_scale( \&\textit{sample}, \&\textit{value} );
	\\
	\tt whizard\_sample\_get\_alpha\_s( \&\textit{sample}, \&\textit{value} );
	\\
	\tt whizard\_sample\_get\_sqme( \&\textit{sample}, \&\textit{value} );
	\\
	\tt whizard\_sample\_get\_weight( \&\textit{sample}, \&\textit{value} );
	\end{quote}
	where the \ttt{\it value} is a variable of appropriate type (see above).

	Event data are stored in a format-specific way. This may be a COMMON block,
	or a \hepmc\ or \lcio\ event record. In the latter cases, cf.\ the \cpp\ API
	below for access information.

	\subsection{C++ main program}
	To link a \cpp\ main program with the \whizard\ library, the following steps
	must be performed:
	\begin{enumerate}
	\item
	Configure, build and install \whizard\ as normal.
	\item
	Include code for accessing \whizard\ functionality in the user program.
	The code should initialize
	\whizard, execute the intended commands, and finalize. For an example, see
	below.
	\item
	Compile the user program with the option that finds the WHIZARD
	\ttt{C/C++} interface header file.
	For instance, if \whizard\ has been installed in \ttt{whizard-path}, this
	should read
	\begin{code}
	-Iwhizard-path/include
	\end{code}
	\item
	Link the program with the necessary libraries (or compile-link in a single
	step). If
	\whizard\ has been installed in a system path, this should work
	automatically. If
	\whizard\ has been installed in a non-default \ttt{whizard-path}, these
	are the options:
	\begin{code}
	-Lwhizard-path/lib -lwhizard -lwhizard_prebuilt -lomega -ltirpc
	\end{code}
	On some systems, you may have to replace \ttt{lib} by \ttt{lib64}.

	If \whizard\ has been compiled with a non-default \fortran\ compiler, you may
	have to explicitly link the appropriate \fortran\ run-time libraries.

	The \ttt{tirpc} library is used by the \ttt{StdHEP} subsystem for \ttt{xdr}
	functionality. This
	library should be present on the host system.

	If additional libraries such as
	\hepmc\ are enabled in the \whizard\ configuration, it may be necessary to
	provide extra options for linking those.
	\item
	Run the program. If necessary, provide the path to the installed shared
	libraries. For instance, if \whizard\ has been installed in
	\ttt{whizard-path}, this should read
	\begin{code}
	export LD_LIBRARY_PATH="whizard-path/lib:$LD_LIBRARY_PATH"
	\end{code}
	On some systems, you may have to replace \ttt{lib} by \ttt{lib64}, as above.

	The \whizard\ subsystem will work with input and output
	files in the current working directory, unless asked to do otherwise.
	\end{enumerate}
	Below is an example program, adapted from \whizard's internal unit-test suite.
	The user program controls the \whizard\ workflow in the same way as a
	\sindarin\ script would do. The commands are a mixture of \sindarin\ command
	calls and functionality for passing information between the \whizard\
	subsystem and the host program.
	In particular, the program can process generated events one-by-one.
	\begin{code}
	#include <cstdio>
	#include <string>
	#include "whizard.h"

	int main( int argc, char* argv[] )
	{
	// WHIZARD and event-sample objects
	Whizard* whizard;
	WhizardSample* sample;

	// Local variables
	double integral, error;
	double sqme, weight;
	int idx;
	int it, it_begin, it_end;

	// Initialize WHIZARD, setting some global option
	whizard = new Whizard();
	whizard->option( "model", "QED" );
	whizard->init();

	// Define a process, set some variables
	whizard->command( "process mupair = e1, E1 => e2, E2" );
	whizard->set_double( "sqrts", 10. );
	whizard->set_int( "seed", 0 );

	// Generate matrix-element code, integrate and retrieve result
	whizard->command( "integrate (mupair)" );

	// Print result
	whizard->get_integration_result( "mupair", &integral, &error );
	printf( " cross section = %5.1f pb\n", integral / 1000. );
	printf( " error = %5.1f pb\n", error / 1000. );

	// Settings for event generation
	whizard->set_string( "$sample", "mupair_events" );
	whizard->set_int( "n_events", 2 );

	// Create an event-sample object and generate events
	sample = whizard->new_sample( "mupair" );
	sample->open( &it_begin, &it_end );
	for (it=it_begin; it<=it_end; it++) {
	sample->next_event();
	idx = sample->get_event_index();
	weight = sample->get_weight();
	sqme = sample->get_sqme();
	printf( "Event #%d\n", idx );
	printf( " sqme = %10.3e\n", sqme );
	printf( " weight = %10.3e\n", weight );
	}

	// Finalize the event-sample object
	sample->close();
	delete sample;

	// Finalize the WHIZARD object
	delete whizard;
	}
	\end{code}

	\subsubsection{Header}
	The necessary declarations are imported by the directive
	\begin{quote}
	\tt \#include "whizard.h"
	\end{quote}

	\subsubsection{Master object}
	All functionality is accessed via a master API object which should be declared
	as follows:
	\begin{quote}
	\tt Whizard* whizard;
	\end{quote}
	The constructor takes no arguments:
	\begin{quote}
	\tt whizard = new Whizard();
	\end{quote}
	There should be only one master object.

	\subsubsection{Pre-Initialization options}
	Before initializing the API object, it is possible to provide options. The
	available options mirror the command-line options of the stand-alone program,
	cf.\ Sec.~\ref{sec:cmdline-options}.
	\begin{quote}
	\tt whizard->option( \textit{key}, \textit{value} );
	\end{quote}
	All keys and values are \cpp\ strings. The available options are
	listed above in the \fortran\ interface documentation.

	\subsubsection{Initialization and finalization}
	After options have been set, the system is initialized via
	\begin{quote}
	\tt whizard->init();
	\end{quote}
	Once initialized, \whizard\ can execute commands as listed below. When all
	is complete, delete the \whizard\ object. This will call the destructor that
	correctly finalizes the \whizard\ workflow.

	\subsubsection{Variables and values}

	In the API, \whizard\ requires numeric data types according to the IEEE
	standard. Integers map to C \ttt{int}, and real values map to C
	\ttt{double}. Logical values map to C \ttt{int} interpreted as \ttt{bool},
	and string values map to \cpp\ \ttt{string}.

	To set a \sindarin\ variable of appropriate type:
	\begin{quote}
	\tt whizard->set\_int ( \textit{name}, \textit{value} );
	\\
	\tt whizard->set\_double ( \textit{name}, \textit{value} );
	\\
	\tt whizard->set\_bool ( \textit{name}, \textit{value} );
	\\
	\tt whizard->set\_string ( \textit{name}, \textit{value} );
	\end{quote}
	\textit{name} is a \cpp\ string value. It must match the corresponding
	\sindarin\ variable name, including any prefix character (\$ or ?).
	\textit{value} is a \ttt{double/int/string}, respectively.

	To retrieve the current value of a variable:
	\begin{quote}
	\tt whizard->get\_int ( \textit{name}, \&\textit{var} );
	\\
	\tt whizard->get\_double ( \textit{name}, \&\textit{var} );
	\\
	\tt whizard->get\_bool ( \textit{name}, \&\textit{var} );
	\\
	\tt whizard->get\_string ( \textit{name}, \&\textit{var} );
	\end{quote}
	Here, \ttt{\it var} is a C variable of appropriate type. The functions return
	zero if the \sindarin\ variable has a known value.

	\subsubsection{Commands}
	Any \sindarin\ command can be called via
	\begin{quote}
	\tt whizard->command( \textit{command} );
	\end{quote}
	\ttt{\it command} is a \cpp\ string value that contains commands as they
	would appear in a \sindarin\ script.

	This includes, in particular, the important commands \ttt{process},
	\ttt{integrate}, and \ttt{simulate}. You may also set variables that way.

	\subsubsection{Retrieving cross-section results}
	This call returns the results (integration and error) from a preceding
	integration run for the process \textit{process-name}:
	\begin{quote}
	\tt whizard->get\_integration\_result( "\textit{process-name}",
	\&\textit{integral}, \&\textit{error} );
	\end{quote}
	\ttt{\it integral} and \ttt{\it error} are variables of type \ttt{double}.
	The function returns zero if the integration run was successful, so integral
	and error are meaningful.

	\subsubsection{Event-sample object}
	A \ttt{simulate} command will produce an event sample. With the appropriate
	settings, the sample will be written to file in any chosen format, to be
	post-processed when it is complete.

	However, a possible purpose of using the \whizard\ API is to process events one-by-one
	when they are generated. To this end, there is an event-sample handle, which
	can be declared in this way:
	\begin{quote}
	\tt WhizardSample* {sample};
	\end{quote}
	An instance \ttt{\it sample} of this type is created by this factory method:
	\begin{quote}
	\tt {sample} = whizard->new\_sample( "\textit{process-name(s)}" );
	\end{quote}
	The command accepts a comma-separated list of process names which should be
	included in the event sample.

	To start event generation for this sample, call
	\begin{quote}
	\tt sample->open( \&\textit{it\_begin},
	\&\textit{it\_end});
	\end{quote}
	where the two output variables (\ttt{int}) \ttt{\it it\_begin} and
	\ttt{\it it\_end}
	provide the bounds for an event loop in the calling program. (In serial mode,
	the bounds are equal to 1 and \ttt{n\_events}, respectively, but in an MPI
	parallel environment, they depend on the computing node.)

	This command generates a new event, to be enclosed within an event loop:
	\begin{quote}
	\tt sample->next\_event();
	\end{quote}
	The event will be available by format-specific access methods, see below.

	This command closes and deletes an event sample after the event loop has
	completed:
	\begin{quote}
	\tt sample->close();
	\end{quote}

	\subsubsection{Retrieving event data}

	After a call to \ttt{sample->next\_event}, the sample object can be
	queried for specific event data.
	\begin{quote}
	\tt value = sample->get\_event\_index();
	\\
	\tt value = sample->get\_process\_index();
	\\
	\tt value = sample->get\_process\_id();
	\\
	\tt value = sample->get\_sqrts();
	\\
	\tt value = sample->get\_fac\_scale();
	\\
	\tt value = sample->get\_alpha\_s();
	\\
	\tt value = sample->get\_sqme();
	\\
	\tt value = sample->get\_weight();
	\end{quote}
	where the \ttt{\it value} is a variable of appropriate type (see above).

	Event data are stored in a format-specific way. This may be a \hepmc\ or
	\lcio\ \cpp\ event record.

	For interfacing with the \hepmc\ event record, the appropriate declarations
	must be in place, e.g.,
	\begin{quote}
	\tt \#include "HepMC/GenEvent.h"
	\\
	using namespace HepMC;
	\end{quote}
	An event-record object must be declared,
	\begin{quote}
	\tt GenEvent* evt;
	\end{quote}
	and the \whizard\ event call must take the event as an argument
	\begin{quote}
	\tt sample->next\_event ( \&evt );
	\end{quote}
	This will create a new \ttt{evt} object.
	Then, the \hepmc\ event record can be accessed via its own methods. After
	an event has been processed, the event record should be deleted
	\begin{quote}
	\tt delete evt;
	\end{quote}

	Analogously, for interfacing with the \lcio\ event record, the appropriate declarations
	must be in place, e.g.,
	\begin{quote}
	\tt
	\#include "lcio.h"
	\\
	\#include "IMPL/LCEventImpl.h"
	\\
	using namespace lcio;
	\end{quote}
	An event-record object must be declared,
	\begin{quote}
	\tt LCEvent* evt;
	\end{quote}
	and the \whizard\ event call must take the event as an argument
	\begin{quote}
	\tt sample->next\_event ( \&evt );
	\end{quote}
	This will create a new \ttt{evt} object.
	Then, the \lcio\ event record can be accessed via its own methods. After
	an event has been processed, the event record should be deleted
	\begin{quote}
	\tt delete evt;
	\end{quote}


	\subsection{Python main program}
	To create a \python\ executable, \whizard\ provides a \ttt{Cython}
	interface that uses \cpp\ bindings to link a dynamic library which can
	then be loaded as a module via \python. Note that \whizard's
	\ttt{Cython}/\python\ interface only works with \python\ttt{v3}. Also
	make sure that you do not mix different \python\ versions when linking
	external programs which also provide \python\ interfaces like
	\hepmc\ or \lcio.

	To link a \python\ main program with the \whizard\ library, the following steps
	must be performed:
	\begin{enumerate}
	\item
	Configure, build and install \whizard\ as normal.
	\item
	Include code for accessing \whizard\ functionality in the user program.
	The code should initialize
	\whizard, execute the intended commands, and finalize. For an example, see
	below.
	\item
	Run \python\ on the user program. Make sure that the operating
	system finds the \whizard\ \python\ and library path.
	If \whizard\ has been installed in a non-default \ttt{whizard-path}, these
	are the options:
	\begin{code}
	export PYTHONPATH=whizard-path/lib/python/site-packages/:$PYTHONPATH
	\end{code}

	If necessary, provide the path to the installed shared
	libraries. For instance, if \whizard\ has been installed in
	\ttt{whizard-path}, this should read
	\begin{code}
	export LD_LIBRARY_PATH="whizard-path/lib:$LD_LIBRARY_PATH"
	\end{code}
	On some systems, you may have to replace \ttt{lib} by \ttt{lib64}, as above.

	The \whizard\ subsystem will work with input and output
	files in the current working directory, unless asked to do otherwise.

	\item
	The \ttt{tirpc} library is used by the \ttt{StdHEP} subsystem for \ttt{xdr}
	functionality. This
	library should be present on the host system.

	\item
	Run the program.
	\end{enumerate}
	Below is an example program, similar to \whizard's internal unit-test
	suite for different external programming languages. The user program
	controls the \whizard\ workflow in the same way as a \sindarin\ script
	would do. The commands are a mixture of \sindarin\ command
	calls and functionality for passing information between the \whizard\
	subsystem and the host program.
	In particular, the program can process generated events one-by-one.
	\begin{code}
	import whizard

	wz = whizard.Whizard()

	wz.option("logfile", "whizard_1_py.log")
	wz.option("job_id", "whizard_1_py_ID")
	wz.option("library", "whizard_1_py_1_lib")
	wz.option("model", "QED")

	wz.init()

	wz.set_double("sqrts", 100)
	wz.set_int("n_events", 3)
	wz.set_bool("?unweighted", True)
	wz.set_string("$sample", "foobar")

	wz.set_int("seed", 0)

	wz.command("process whizard_1_py_1_p = e1, E1 => e2, E2")
	wz.command("iterations = 1:100")

	integral, error = wz.get_integration_result("whizard_1_py_1_p")
	print(integral, error)

	wz.command("integrate (whizard_1_py_1_p)")
	sqrts = wz.get_double("sqrts")
	print(f"sqrts = {sqrts:5.1f} GeV")
	print(f"sigma = integral:5.1f} pb")
	print(f"error {error:5.1f} pb")

	sample = wz.new_sample("whizard_1_py_p1, whizard_1_py_p2, whizard_1_py_p3")
	it_begin, it_end = sample.open()
	for it in range(it_begin, it_end + 1):
	sample.next_event()
	idx = sample.get_event_index()
	i_proc = sample.get_process_index()
	proc_id = sample.get_process_id()
	f_scale = sample.get_fac_scale()
	alpha_s = sample.get_alpha_s()
	weight = sample.get_weight()
	sqme = sample.get_sqme()
	print(f"Event #{idx}")
	print(f" process #{i_proc}")
	print(f" proc_id = {proc_id}")
	print(f" f_scale = {f_scale:10.3e}")
	print(f" alpha_s = {f_scale:10.3e}")
	print(f" sqme = {f_scale:10.3e}")
	print(f" weight = {f_scale:10.3e}")

	sample.close()

	del(wz)
	\end{code}

	\subsubsection{Python module import}
	There are no necessary headers here as all of this information has
	been automatically taken care by the \ttt{Cython} interface layer. The
	\whizard\ module needs to be imported by \python\:
	\begin{quote}
	\tt import whizard
	\end{quote}

	\subsubsection{Master object}
	All functionality is accessed via a master API object which should be declared
	as follows:
	\begin{quote}
	\tt wz = whizard.Whizard()
	\end{quote}
	The constructor takes no arguments.There should be only one master
	object.

	\subsubsection{Pre-Initialization options}
	Before initializing the API object, it is possible to provide options. The
	available options mirror the command-line options of the stand-alone program,
	cf.\ Sec.~\ref{sec:cmdline-options}.
	\begin{quote}
	\tt wz.option( \textit{key}, \textit{value} );
	\end{quote}
	All keys and values are \python\ strings. The available options are
	listed above in the \fortran\ interface documentation.

	\subsubsection{Initialization and finalization}
	After options have been set, the system is initialized via
	\begin{quote}
	\tt wz.init()
	\end{quote}
	Once initialized, \whizard\ can execute commands as listed below. When all
	is complete, delete the \whizard\ object. This will call the destructor that
	correctly finalizes the \whizard\ workflow.

	\subsubsection{Variables and values}

	In the API, \whizard\ requires numeric data types according to the IEEE
	standard. Integers map to \ttt{Python int}, and real values map to \ttt{Python
	double}. Logical values map to \ttt{True} and \ttt{False},
	and string values map to \python\ strings.

	To set a \sindarin\ variable of appropriate type:
	\begin{quote}
	\tt wz.set\_int ( \textit{name}, \textit{value} );
	\\
	\tt wz.set\_double ( \textit{name}, \textit{value} );
	\\
	\tt wz.set\_bool ( \textit{name}, \textit{value} );
	\\
	\tt wz.set\_string ( \textit{name}, \textit{value} );
	\end{quote}
	\textit{name} is a \python\ string value. It must match the corresponding
	\sindarin\ variable name, including any prefix character (\$ or ?).
	\textit{value} is a \ttt{double/int/string}, respectively.

	To retrieve the current value of a variable:
	\begin{quote}
	\tt wz.get\_int ( \textit{name}, \textit{var} );
	\\
	\tt wz.get\_double ( \textit{name}, \textit{var} );
	\\
	\tt wz.get\_bool ( \textit{name}, \textit{var} );
	\\
	\tt wz.get\_string ( \textit{name}, \textit{var} );
	\end{quote}
	Here, \ttt{\it var} is a \python\ variable of appropriate type. The
	functions return zero if the \sindarin\ variable has a known value.

	\subsubsection{Commands}
	Any \sindarin\ command can be called via
	\begin{quote}
	\tt wz.command( \textit{command} );
	\end{quote}
	\ttt{\it command} is a \python\ string value that contains commands as they
	would appear in a \sindarin\ script.

	This includes, in particular, the important commands \ttt{process},
	\ttt{integrate}, and \ttt{simulate}. You may also set variables that way.

	\subsubsection{Retrieving cross-section results}
	This call returns the results (integration and error) from a preceding
	integration run for the process \textit{process-name}:
	\begin{quote}
	\tt wz.get\_integration\_result( "\textit{process-name}",
	\textit{integral}, \textit{error} );
	\end{quote}
	\ttt{\it integral} and \ttt{\it error} are variables of type \ttt{double}.
	The function returns zero if the integration run was successful, so integral
	and error are meaningful.

	\subsubsection{Event-sample object}
	A \ttt{simulate} command will produce an event sample. With the appropriate
	settings, the sample will be written to file in any chosen format, to be
	post-processed when it is complete.

	However, a possible purpose of using the \whizard\ API is to process events one-by-one
	when they are generated. To this end, there is an event-sample handle, which
	can be declared in this way:
	\begin{quote}
	\tt WhizardSample* {sample};
	\end{quote}
	An instance \ttt{\it sample} of this type is created by this factory method:
	\begin{quote}
	\tt {sample} = wz.new\_sample( "\textit{process-name(s)}" );
	\end{quote}
	The command accepts a comma-separated list of process names which should be
	included in the event sample.

	To start event generation for this sample, call
	\begin{quote}
	\tt \textit{it\_begin}, \textit{it\_end} = wz.sample\_open()
	\end{quote}
	where the two output variables (\ttt{int}) \ttt{\it it\_begin} and
	\ttt{\it it\_end}
	provide the bounds for an event loop in the calling program. (In serial mode,
	the bounds are equal to 1 and \ttt{n\_events}, respectively, but in an MPI
	parallel environment, they depend on the computing node.)

	This command generates a new event, to be enclosed within an event loop:
	\begin{quote}
	\tt sample.next\_event();
	\end{quote}
	The event will be available by format-specific access methods, see below.

	This command closes and deletes an event sample after the event loop has
	completed:
	\begin{quote}
	\tt sample.close();
	\end{quote}

	\subsubsection{Retrieving event data}

	After a call to \ttt{sample.next\_event}, the sample object can be
	queried for specific event data.
	\begin{quote}
	\tt value = sample.get\_event\_index();
	\\
	\tt value = sample.get\_process\_index();
	\\
	\tt value = sample.get\_process\_id();
	\\
	\tt value = sample.get\_sqrts();
	\\
	\tt value = sample.get\_fac\_scale();
	\\
	\tt value = sample.get\_alpha\_s();
	\\
	\tt value = sample.get\_sqme();
	\\
	\tt value = sample.get\_weight();
	\end{quote}
	where the \ttt{\it value} is a variable of appropriate type (see above).

	Event data are stored in a format-specific way. This may be a \hepmc\ or
	\lcio\ \cpp\ event record, or some formats supported by
	\whizard\ intrinsically like LHEF etc.

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{Examples}
	\label{chap:examples}

	In this chapter we discuss the running and steering of \whizard\ with
	the help of several examples. These examples can be found in the
	\ttt{share/examples} directory of your installation. All of these
	examples are also shown on the \whizard\ Wiki page:
	\url{https://whizard.hepforge.org/trac/wiki}.


	\section{$Z$ lineshape at LEP I}

	By this example, we demonstrate how a scan over collision energies
	works, using as example the measurement of the $Z$ lineshape at LEP I
	in 1989. The \sindarin\ script for this example, \ttt{Z-lineshape.sin}
	can be found in the \ttt{share/examples} folder of the \whizard\
	installation.

	We first use the Standard model as physics model:
	\begin{code}
	model = SM
	\end{code}
	Aliases for electron, muon and their antiparticles as leptons and
	those including the photon as particles in general are introduced:
	\begin{code}
	alias lep = e1:E1:e2:E2
	alias prt = lep:A
	\end{code}
	Next, the two processes are defined, \eemm, and the same with an
	explicit QED photon: $e^+e^- \to \mu^+\mu^-\gamma$,
	\begin{code}
	process bornproc = e1, E1 => e2, E2
	process rc = e1, E1 => e2, E2, A
	compile
	\end{code}
	and the processes are compiled. Now, we define some very loose cuts to
	avoid singular regions in phase space, name an infrared cutoff of 100
	MeV for all particles, a cut on the angular separation from the beam
	axis and a di-particle invariant mass cut which regularizes collinear
	singularities:
	\begin{code}
	cuts = all E >= 100 MeV [prt]
	and all abs (cos(Theta)) <= 0.99 [prt]
	and all M2 >= (1 GeV)^2 [prt, prt]
	\end{code}
	For the graphical analysis, we give a description and labels for the
	$x$- and $y$-axis in \LaTeX\ syntax:
	\begin{code}
	$description = "A WHIZARD Example"
	$x_label = "$\sqrt{s}$/GeV"
	$y_label = "$\sigma(s)$/pb"
	\end{code}
	We define two plots for the lineshape of the \eemm\ process between 88
	and 95 GeV,
	\begin{code}
	$title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-$"
	plot lineshape_born { x_min = 88 GeV x_max = 95 GeV }
	\end{code}
	and the same for the radiative process with an additional photon:
	\begin{code}
	$title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-\gamma$"
	plot lineshape_rc { x_min = 88 GeV x_max = 95 GeV }
	\end{code}
	%$
	The next part of the \sindarin\ file actually performs the scan:
	\begin{code}
	scan sqrts = ((88.0 GeV => 90.0 GeV /+ 0.5 GeV),
	(90.1 GeV => 91.9 GeV /+ 0.1 GeV),
	(92.0 GeV => 95.0 GeV /+ 0.5 GeV)) {
	beams = e1, E1
	integrate (bornproc) { iterations = 2:1000:"gw", 1:2000 }
	record lineshape_born (sqrts, integral (bornproc) / 1000)
	integrate (rc) { iterations = 5:3000:"gw", 2:5000 }
	record lineshape_rc (sqrts, integral (rc) / 1000)
	}
	\end{code}
	So from 88 to 90 GeV, we go in 0.5 GeV steps, then from 90 to 92 GeV
	in tenth of GeV, and then up to 95 GeV again in half a GeV steps. The
	partonic beam definition is redundant. Then, the born process is
	integrated, using a certain specification of calls with adaptation of
	grids and weights, as well as a final pass. The lineshape of the Born
	process is defined as a \ttt{record} statement, generating tuples of
	$\sqrt{s}$ and the Born cross section (converted from femtobarn to
	picobarn). The same happens for the radiative $2\to3$ process with a
	bit more iterations because of the complexity, and the definition of
	the corresponding lineshape record.

	If you run the \sindarin\ script, you will find an output like:
	\begin{scriptsize}
	\begin{Verbatim}[frame=single]
	\| Process library 'default_lib': loading
	\| Process library 'default_lib': ... success.
	$description = "A WHIZARD Example"
	$x_label = "$\sqrt{s}$/GeV"
	$y_label = "$\sigma(s)$/pb"
	$title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-$"
	x_min = 8.800000000000E+01
	x_max = 9.500000000000E+01
	$title = "The Z Lineshape in $e^+e^-\to\mu^+\mu^-\gamma$"
	x_min = 8.800000000000E+01
	x_max = 9.500000000000E+01
	sqrts = 8.800000000000E+01
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 10713
	\| Initializing integration for process bornproc:
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'bornproc'
	\| Library name = 'default_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'bornproc_i1': e-, e+ => mu-, mu+ [omega]
	\| ------------------------------------------------------------------------
	\| Beam structure: e-, e+
	\| Beam data (collision):
	\| e- (mass = 5.1099700E-04 GeV)
	\| e+ (mass = 5.1099700E-04 GeV)
	\| sqrts = 8.800000000000E+01 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'bornproc_i1.phs'
	\| Phase space: 1 channels, 2 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: Using 1 equivalence between channels.
	\| Phase space: wood
	\| Applying user-defined cuts.
	\| OpenMP: Using 8 threads
	\| Starting integration for process 'bornproc'
	\| Integrate: iterations = 2:1000:"gw", 1:2000
	\| Integrator: 1 chains, 1 channels, 2 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 1000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 800 2.5881432E+05 1.85E+03 0.72 0.20* 48.97
	2 800 2.6368495E+05 9.25E+02 0.35 0.10* 28.32
	\|-----------------------------------------------------------------------------\|
	2 1600 2.6271122E+05 8.28E+02 0.32 0.13 28.32 5.54 2
	\|-----------------------------------------------------------------------------\|
	3 1988 2.6313791E+05 5.38E+02 0.20 0.09* 35.09
	\|-----------------------------------------------------------------------------\|
	3 1988 2.6313791E+05 5.38E+02 0.20 0.09 35.09
	\|=============================================================================\|
	\| Time estimate for generating 10000 events: 0d:00h:00m:05s
	[.......]
	\end{Verbatim}
	\end{scriptsize} %$
	and then the integrations for the other energy points of the scan will
	\begin{figure}
	\centering
	\includegraphics[width=.47\textwidth]{Z-lineshape_1}
	\includegraphics[width=.47\textwidth]{Z-lineshape_2}
	\caption{\label{fig:zlineshape} $Z$ lineshape in the dimuon final
	state (left), and with an additional photon (right)}
	\end{figure}
	follow, and finally the same is done for the radiative process as
	well. At the end of the \sindarin\ script we compile the graphical
	\whizard\ analysis and direct the data for the plots into the file
	\ttt{Z-lineshape.dat}:
	\begin{code}
	compile_analysis { $out_file = "Z-lineshape.dat" }
	\end{code}
	%$
	In this case there is no event generation, but simply the cross
	section values for the scan are dumped into a data file:
	\begin{scriptsize}
	\begin{Verbatim}[frame=single]
	$out_file = "Z-lineshape.dat"
	\| Opening file 'Z-lineshape.dat' for output
	\| Writing analysis data to file 'Z-lineshape.dat'
	\| Closing file 'Z-lineshape.dat' for output
	\| Compiling analysis results display in 'Z-lineshape.tex'
	\end{Verbatim}
	\end{scriptsize}
	%$
	Fig.~\ref{fig:zlineshape} shows the graphical \whizard\ output of the
	$Z$ lineshape in the dimuon final state from the scan on the left, and
	the same for the radiative process with an additional photon on the
	right.

	%%%%%%%%%%%%%%%

	\section{$W$ pairs at LEP II}

	This example which can be found as file \ttt{LEP\_cc10.sin} in the
	\ttt{share/examples} directory, shows $W$ pair production in the
	semileptonic mode at LEP II with its final energy of 209 GeV. Because
	there are ten contributing Feynman diagrams, the process has been
	dubbed CC10: charged current process with 10 diagrams. We work within
	the Standard Model:
	\begin{code}
	model = SM
	\end{code}
	Then the process is defined, where no flavor summation is done for the
	jets here:
	\begin{code}
	process cc10 = e1, E1 => e2, N2, u, D
	\end{code}
	A compilation statement is optional, and then we set the muon mass to
	zero:
	\begin{code}
	mmu = 0
	\end{code}
	The final LEP center-of-momentum energy of 209 GeV is set:
	\begin{code}
	sqrts = 209 GeV
	\end{code}
	Then, we integrate the process:
	\begin{code}
	integrate (cc10) { iterations = 12:20000 }
	\end{code}
	Running the \sindarin\ file up to here, results in the output:
	\begin{scriptsize}
	\begin{Verbatim}[frame=single]
	\| Process library 'default_lib': loading
	\| Process library 'default_lib': ... success.
	SM.mmu = 0.000000000000E+00
	sqrts = 2.090000000000E+02
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 31255
	\| Initializing integration for process cc10:
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'cc10'
	\| Library name = 'default_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'cc10_i1': e-, e+ => mu-, numubar, u, dbar [omega]
	\| ------------------------------------------------------------------------
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e- (mass = 5.1099700E-04 GeV)
	\| e+ (mass = 5.1099700E-04 GeV)
	\| sqrts = 2.090000000000E+02 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'cc10_i1.phs'
	\| Phase space: 25 channels, 8 dimensions
	\| Phase space: found 25 channels, collected in 7 groves.
	\| Phase space: Using 25 equivalences between channels.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| OpenMP: Using 8 threads
	\| Starting integration for process 'cc10'
	\| Integrate: iterations = 12:20000
	\| Integrator: 7 chains, 25 channels, 8 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 20000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 19975 6.4714908E+02 2.17E+01 3.36 4.75* 2.33
	2 19975 7.3251876E+02 2.45E+01 3.34 4.72* 2.17
	3 19975 6.7746497E+02 2.39E+01 3.52 4.98 1.77
	4 19975 7.2075198E+02 2.41E+01 3.34 4.72* 1.76
	5 19975 6.5976152E+02 2.26E+01 3.43 4.84 1.46
	6 19975 6.6633310E+02 2.26E+01 3.39 4.79* 1.43
	7 19975 6.7539385E+02 2.29E+01 3.40 4.80 1.43
	8 19975 6.6754027E+02 2.11E+01 3.15 4.46* 1.41
	9 19975 7.3975817E+02 2.52E+01 3.40 4.81 1.53
	10 19975 7.2284275E+02 2.39E+01 3.31 4.68* 1.47
	11 19975 6.5476917E+02 2.18E+01 3.33 4.71 1.33
	12 19975 7.2963866E+02 2.54E+01 3.48 4.92 1.46
	\|-----------------------------------------------------------------------------\|
	12 239700 6.8779583E+02 6.69E+00 0.97 4.76 1.46 2.18 12
	\|=============================================================================\|
	\| Time estimate for generating 10000 events: 0d:00h:01m:16s
	\| Creating integration history display cc10-history.ps and cc10-history.pdf
	\end{Verbatim}
	\end{scriptsize}
	\begin{figure}
	\centering
	\includegraphics[width=.6\textwidth]{cc10_1}
	\\\vspace{5mm}
	\includegraphics[width=.6\textwidth]{cc10_2}
	\caption{Histogram of the dijet invariant mass from the CC10 $W$
	pair production at LEP II, peaking around the $W$ mass (upper
	plot), and of the muon energy (lower plot).}
	\label{fig:cc10}
	\end{figure}
	The next step is event generation. In order to get smooth
	distributions, we set the integrated luminosity to 10
	fb${}^{-1}$. (Note that LEP II in its final year 2000 had an
	integrated luminosity of roughly 0.2 fb${}^{-1}$.)
	\begin{code}
	luminosity = 10
	\end{code}
	With the simulated events corresponding to those 10 inverse femtobarn
	we want to perform a \whizard\ analysis: we are going to plot the
	dijet invariant mass, as well as the energy of the outgoing muon. For
	the plot of the analysis, we define a description and label the $y$
	axis:
	\begin{code}
	$description =
	"A WHIZARD Example.
	Charged current CC10 process from LEP 2."
	$y_label = "$N_{\textrm{events}}$"
	\end{code}
	We also use \LaTeX-syntax for the title of the first plot and the
	$x$-label, and then define the histogram of the dijet invariant mass
	in the range around the $W$ mass from 70 to 90 GeV in steps of half a
	GeV:
	\begin{code}
	$title = "Di-jet invariant mass $M_{jj}$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
	$x_label = "$M_{jj}$/GeV"
	histogram m_jets (70 GeV, 90 GeV, 0.5 GeV)
	\end{code}
	And we do the same for the second histogram of the muon energy:
	\begin{code}
	$title = "Muon energy $E_\mu$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
	$x_label = "$E_\mu$/GeV"
	histogram e_muon (0 GeV, 209 GeV, 4)
	\end{code}
	Now, we define the \ttt{analysis} consisting of two \ttt{record}
	statements initializing the two observables that are plotted as
	histograms:
	\begin{code}
	analysis = record m_jets (eval M [u,D]);
	record e_muon (eval E [e2])
	\end{code}
	At the very end, we perform the event generation
	\begin{code}
	simulate (cc10)
	\end{code}
	and finally the writing and compilation of the analysis in a named
	data file:
	\begin{code}
	compile_analysis { $out_file = "cc10.dat" }
	\end{code}
	This event generation part screen output looks like this:
	\begin{scriptsize}
	\begin{Verbatim}[frame=single]
	luminosity = 1.000000000000E+01
	$description = "A WHIZARD Example.
	Charged current CC10 process from LEP 2."
	$y_label = "$N_{\textrm{events}}$"
	$title = "Di-jet invariant mass $M_{jj}$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
	$x_label = "$M_{jj}$/GeV"
	$title = "Muon energy $E_\mu$ in $e^+e^- \to \mu^- \bar\nu_\mu u \bar d$"
	$x_label = "$E_\mu$/GeV"
	\| Starting simulation for process 'cc10'
	\| Simulate: using integration grids from file 'cc10_m1.vg'
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 9910
	\| OpenMP: Using 8 threads
	\| Simulation: using n_events as computed from luminosity value
	\| Events: writing to raw file 'cc10.evx'
	\| Events: generating 6830 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	Warning: Encountered events with excess weight: 39 events ( 0.571 %)
	\| Maximum excess weight = 1.027E+00
	\| Average excess weight = 6.764E-04
	\| Events: closing raw file 'cc10.evx'
	$out_file = "cc10.dat"
	\| Opening file 'cc10.dat' for output
	\| Writing analysis data to file 'cc10.dat'
	\| Closing file 'cc10.dat' for output
	\| Compiling analysis results display in 'cc10.tex'
	\end{Verbatim}
	\end{scriptsize} %$
	Then comes the \LaTeX\ output of the compilation of the graphical
	analysis. Fig.~\ref{fig:cc10} shows the two histograms as the are
	produced as result of the \whizard\ internal graphical analysis.

	%%%%%%%%%%%%%%%

	\section{Higgs search at LEP II}

	This example can be found under the name \ttt{LEP\_higgs.sin} in the
	\ttt{share/doc} folder of \whizard. It displays different search
	channels for a very light would-be SM Higgs boson of mass 115 GeV at
	the LEP II machine at its highest energy it finally achieved, 209 GeV.
	First, we use the Standard Model:
	\begin{code}
	model = SM
	\end{code}
	Then, we define aliases for neutrinos, antineutrinos, light quarks and
	light anti-quarks:
	\begin{code}
	alias n = n1:n2:n3
	alias N = N1:N2:N3
	alias q = u:d:s:c
	alias Q = U:D:S:C
	\end{code}
	Now, we define the signal process, which is Higgsstrahlung,
	\begin{code}
	process zh = e1, E1 => Z, h
	\end{code}
	the missing-energy channel,
	\begin{code}
	process nnbb = e1, E1 => n, N, b, B
	\end{code}
	and finally the 4-jet as well as dilepton-dijet channels:
	\begin{code}
	process qqbb = e1, E1 => q, Q, b, B
	process bbbb = e1, E1 => b, B, b, B
	process eebb = e1, E1 => e1, E1, b, B
	process qqtt = e1, E1 => q, Q, e3, E3
	process bbtt = e1, E1 => b, B, e3, E3

	compile
	\end{code}
	and we compile the code. We set the center-of-momentum energy to the
	highest energy LEP II achieved,
	\begin{code}
	sqrts = 209 GeV
	\end{code}
	For the Higgs boson, we take the values of a would-be SM Higgs boson
	with mass of 115 GeV, which would have had a width of a bit more than
	3 MeV:
	\begin{code}
	mH = 115 GeV
	wH = 3.228 MeV
	\end{code}
	We take a running $b$ quark mass to take into account NLO corrections
	to the $Hb\bar b$ vertex, while all other fermions are massless:
	\begin{code}
	mb = 2.9 GeV
	me = 0
	ms = 0
	mc = 0
	\end{code}
	\begin{scriptsize}
	\begin{Verbatim}[frame=single]
	\| Process library 'default_lib': loading
	\| Process library 'default_lib': ... success.
	sqrts = 2.090000000000E+02
	SM.mH = 1.150000000000E+02
	SM.wH = 3.228000000000E-03
	SM.mb = 2.900000000000E+00
	SM.me = 0.000000000000E+00
	SM.ms = 0.000000000000E+00
	SM.mc = 0.000000000000E+00
	\end{Verbatim}
	\end{scriptsize}
	To avoid soft-collinear singular phase-space regions, we apply an
	invariant mass cut on light quark pairs:
	\begin{code}
	cuts = all M >= 10 GeV [q,Q]
	\end{code}
	Now, we integrate the signal process as well as the combined signal
	and background processes:
	\begin{code}
	integrate (zh) { iterations = 5:5000}

	integrate(nnbb,qqbb,bbbb,eebb,qqtt,bbtt) { iterations = 12:20000 }
	\end{code}
	\begin{scriptsize}
	\begin{Verbatim}[frame=single]
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 21791
	\| Initializing integration for process zh:
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'zh'
	\| Library name = 'default_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'zh_i1': e-, e+ => Z, H [omega]
	\| ------------------------------------------------------------------------
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e- (mass = 0.0000000E+00 GeV)
	\| e+ (mass = 0.0000000E+00 GeV)
	\| sqrts = 2.090000000000E+02 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'zh_i1.phs'
	\| Phase space: 1 channels, 2 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: Using 1 equivalence between channels.
	\| Phase space: wood
	\| Applying user-defined cuts.
	\| OpenMP: Using 8 threads
	\| Starting integration for process 'zh'
	\| Integrate: iterations = 5:5000
	\| Integrator: 1 chains, 1 channels, 2 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 5000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 4608 1.6114109E+02 5.52E-04 0.00 0.00* 99.43
	2 4608 1.6114220E+02 5.59E-04 0.00 0.00 99.43
	3 4608 1.6114103E+02 5.77E-04 0.00 0.00 99.43
	4 4608 1.6114111E+02 5.74E-04 0.00 0.00* 99.43
	5 4608 1.6114103E+02 5.66E-04 0.00 0.00* 99.43
	\|-----------------------------------------------------------------------------\|
	5 23040 1.6114130E+02 2.53E-04 0.00 0.00 99.43 0.82 5
	\|=============================================================================\|
	[.....]
	\end{Verbatim}
	\end{scriptsize}
	\begin{figure}
	\centering
	\includegraphics[width=.48\textwidth]{lep_higgs_1}
	\includegraphics[width=.48\textwidth]{lep_higgs_2}
	\\\vspace{5mm}
	\includegraphics[width=.48\textwidth]{lep_higgs_3}
	\caption{Upper line: final state $bb + E_{miss}$, histogram of
	the invisible mass distribution (left), and of the di-$b$
	distribution (right). Lower plot: light dijet distribution in the
	$bbjj$ final state.}
	\label{fig:lep_higgs}
	\end{figure}
	Because the other integrations look rather similar, we refrain from
	displaying them here, too. As a next step, we define titles,
	descriptions and axis labels for the histograms we want to
	generate. There are two of them, one os the invisible mass
	distribution, the other is the di-$b$-jet invariant mass. Both
	histograms are taking values between 70 and 130 GeV with
	bin widths of half a GeV:
	\begin{code}
	$description =
	"A WHIZARD Example. Light Higgs search at LEP. A 115 GeV pseudo-Higgs
	has been added. Luminosity enlarged by two orders of magnitude."
	$y_label = "$N_{\textrm{events}}$"

	$title = "Invisible mass distribution in $e^+e^- \to \nu\bar\nu b \bar b$"
	$x_label = "$M_{\nu\nu}$/GeV"
	histogram m_invisible (70 GeV, 130 GeV, 0.5 GeV)

	$title = "$bb$ invariant mass distribution in $e^+e^- \to \nu\bar\nu b \bar b$"
	$x_label = "$M_{b\bar b}$/GeV"
	histogram m_bb (70 GeV, 130 GeV, 0.5 GeV)
	\end{code}
	The analysis is initialized by defining the two records for the
	invisible mass and the invariant mass of the two $b$ jets:
	\begin{code}
	analysis = record m_invisible (eval M [n,N]);
	record m_bb (eval M [b,B])
	\end{code}
	In order to have enough statistics, we enlarge the LEP integrated
	luminosity at 209 GeV by more than two orders of magnitude:
	\begin{code}
	luminosity = 10
	\end{code}
	We start event generation by simulating the process with two $b$ jets
	and two neutrinos in the final state:
	\begin{code}
	simulate (nnbb)
	\end{code}
	As a third histogram, we define the dijet invariant mass of two light
	jets:
	\begin{code}
	$title = "Dijet invariant mass distribution in $e^+e^- \to q \bar q b \bar b$"
	$x_label = "$M_{q\bar q}$/GeV"
	histogram m_jj (70 GeV, 130 GeV, 0.5 GeV)
	\end{code}
	Then we simulate the 4-jet process defining the light-dijet
	distribution as a local record:
	\begin{code}
	simulate (qqbb) { analysis = record m_jj (eval M / 1 GeV [combine [q,Q]]) }
	\end{code}
	Finally, we compile the analysis,
	\begin{code}
	compile_analysis { $out_file = "lep_higgs.dat" }
	\end{code}
	\begin{scriptsize}
	\begin{Verbatim}[frame=single]
	\| Starting simulation for process 'nnbb'
	\| Simulate: using integration grids from file 'nnbb_m1.vg'
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 21798
	\| OpenMP: Using 8 threads
	\| Simulation: using n_events as computed from luminosity value
	\| Events: writing to raw file 'nnbb.evx'
	\| Events: generating 1070 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	Warning: Encountered events with excess weight: 207 events ( 19.346 %)
	\| Maximum excess weight = 1.534E+00
	\| Average excess weight = 4.909E-02
	\| Events: closing raw file 'nnbb.evx'
	$title = "Dijet invariant mass distribution in $e^+e^- \to q \bar q b \bar b$"
	$x_label = "$M_{q\bar q}$/GeV"
	\| Starting simulation for process 'qqbb'
	\| Simulate: using integration grids from file 'qqbb_m1.vg'
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 21799
	\| OpenMP: Using 8 threads
	\| Simulation: using n_events as computed from luminosity value
	\| Events: writing to raw file 'qqbb.evx'
	\| Events: generating 4607 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	Warning: Encountered events with excess weight: 112 events ( 2.431 %)
	\| Maximum excess weight = 8.875E-01
	\| Average excess weight = 4.030E-03
	\| Events: closing raw file 'qqbb.evx'
	$out_file = "lep_higgs.dat"
	\| Opening file 'lep_higgs.dat' for output
	\| Writing analysis data to file 'lep_higgs.dat'
	\| Closing file 'lep_higgs.dat' for output
	\| Compiling analysis results display in 'lep_higgs.tex'
	\end{Verbatim}
	\end{scriptsize}
	The graphical analysis of the events generated by \whizard\ are shown
	in Fig.~\ref{fig:lep_higgs}. In the upper left, the invisible mass
	distribution in the $b\bar b + E_{miss}$ state is shown, peaking
	around the $Z$ mass. The upper right shows the $M(b\bar b)$
	distribution in the same final state, while the lower plot has the
	invariant mass distribution of the two non-$b$-tagged (light) jets in
	the $bbjj$ final state. The latter shows only the $Z$
	peak, while the former exhibits the narrow would-be 115 GeV Higgs
	state.

	%%%%%%%%%%%%%%%

	\section{Deep Inelastic Scattering at HERA}

	%%%%%%%%%%%%%%%

	\section{$W$ endpoint at LHC}

	%%%%%%%%%%%%%%%

	\section{SUSY Cascades at LHC}

	%%%%%%%%%%%%%%%

	\section{Polarized $WW$ at ILC}

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{Technical details -- Advanced Spells}
	\label{chap:tuning}

	\section{Efficiency and tuning}

	Since massless fermions and vector bosons (or almost massless states
	in a certain approximation) lead to restrictive selection rules for
	allowed helicity combinations in the initial and final state. To make
	use of this fact for the efficiency of the \whizard\ program, we are
	applying some sort of heuristics: \whizard\ dices events into all
	combinatorially possible helicity configuration during a warm-up
	phase. The user can specify a helicity threshold which sets the number
	of zeros \whizard\ should have got back from a specific helicity
	combination in order to ignore that combination from now on. By that
	mechanism, typically half up to more than three quarters of all
	helicity combinations are discarded (and hence the corresponding
	number of matrix element calls). This reduces calculation time up to
	more than one order of magnitude. \whizard\ shows at the end of the
	integration those helicity combinations which finally contributed to
	the process matrix element.

	Note that this list -- due to the numerical heuristics -- might very
	well depend on the number of calls for the matrix elements per
	iteration, and also on the corresponding random number seed.

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{New External Physics Models}
	\label{chap:extmodels}

	It is never possible to include all incarnations of physics models that
	can be described by the maybe weirdest form of a quantum field theory
	in a tailor-made implementation within a program like \whizard. Users
	clearly want to be able to use their own special type of model; in
	order to do so there are external tools to translate models described
	by their field content and Lagrangian densities into Feynman rules and
	make them available in an event generator like \whizard. In this
	chapter, we describe the interfaces to two such external models,
	\sarah\ and \FeynRules.

	The \FeynRules\ interface had been started already for the legacy
	version \whizard\ttt{1} (where it had to be downloaded from
	\url{https://whizard.hepforge.org} as a separate package), but
	for the \whizard\ttt{two} release series it has been included in the
	\FeynRules\ package (from their version v1.6.0 on). Note that there
	was a regression for the usage of external models (from either \sarah\
	or \FeynRules) in the first release of series v2.2, v2.2.0. This has
	been fixed in all upcoming versions.

	Besides using \sarah\ or \FeynRules\ via their interfaces, there is
	now a much easier way to let those programs output model files in the
	"Universal FeynRules Output" (or \UFO). This option does not have any
	principle limitations for models, and also does not rely on the never
	truly constant interfaces between two different tools. Their usage is
	described in Sec.~\ref{sec:ufo}.

	%%%%%%%%%%%%%%%

	\section{New physics models via \sarah}
	\sarah~\cite{Staub:2008uz,Staub:2009bi,Staub:2010jh,Staub:2012pb,Staub:2013tta}
	is a \Mathematica~\cite{mathematica} package which
	derives for a given model the
	minimum conditions of the vacuum, the mass matrices, and vertices at tree-level
	as well as expressions for the one-loop corrections for all masses and the
	full two-loop renormalization group equations (RGEs). The vertices can be exported
	to be used with \whizard/\oMega. All other information can be used to generate
	\fortran\ source code for the RGE solution tool and spectrum generator
	\spheno~\cite{Porod:2003um,Porod:2011nf} to get a spectrum generator
	for any model. The
	advantage is that \spheno\ calculates a consistent set of parameters (couplings,
	masses, rotation matrices, decay widths) which can be used as input for \whizard.
	\sarah\ and \spheno\ can be also downloaded from the \ttt{HepForge} server:
	\begin{center}
	\url{https://sarah.hepforge.org} \\
	\url{https://spheno.hepforge.org}
	\end{center}


	\subsection{\whizard/\oMega\ model files from \sarah}

	\subsubsection{Generating the model files}

	Here we are giving only the information relevant to generate models
	for \whizard. For more details about the installation of \sarah\ and
	an exhaustion documentation about its usage, confer the \sarah\
	manual.

	To generate the model files for \whizard/\oMega\ with \sarah, a
	new \Mathematica\ session has to be started. \sarah\ is loaded via
	\begin{code}
	<<SARAH-4.2.1/SARAH.m;
	\end{code}
	if \sarah\ has been stored in the applications directory of
	\Mathematica. Otherwise, the full path has to be given
	\begin{code}
	<<[Path_to_SARAH]/SARAH.m;
	\end{code}
	To get an overview which models are delivered with \sarah, the command \verb"ShowModels"
	can be used. As an example, we use in the following the triplet
	extended MSSM (TMSSM) and initialize it in \sarah\ via
	\begin{code}
	Start["TMSSM"];
	\end{code}
	Finally, the output intended for \whizard/\oMega\ is started via
	\begin{code}
	MakeWHIZARD[Options]
	\end{code}
	The possible options of the \verb"MakeWHIZARD" command are
	\begin{enumerate}
	\item \verb"WriteOmega", with values: \verb"True" or \verb"False", default:
	\verb"True" \\
	Defines if the model files for \oMega\ should be written
	\item \verb"WriteWHIZARD", with values: \verb"True" or \verb"False",
	default: \verb"True" \\
	Defines if the model files for \whizard\ should be written
	\item \verb"Exclude", with values: list of generic type, Default:
	\verb"{SSSS}" \\
	Defines which generic vertices are {\em not} exported to the model
	file
	\item \verb"WOModelName", with values: string, default: name of the
	model in \sarah\ followed by \verb"_sarah" \\
	Gives the possibility to change the model name
	\item \verb"MaximalCouplingsPerFile", with values: integer, default:
	\ttt{150} \\
	Defines the maximal number of couplings written per file
	\item \verb"Version", with values: formatted number, Default:
	\verb"2.2.1"~\footnote{Due to a regression in \whizard\ version
	v2.2.0, \sarah\ models cannot be successfully linked within
	that version. Hence, the default value here has been set to
	version number 2.2.1}, \\
	Defines the version of \whizard\ for which the model file is generated
	\end{enumerate}
	All options and the default values are also shown in the
	\Mathematica\ session via \newline\verb"Options[MakeWHIZARD]".

	\subsubsection{Using the generated model files with \whizard}

	After the interface has completed evaluation, the generated files can
	be found in the subdirectory \verb"WHIZARD_Omega" of {\sarah}s output
	directory. In order to use it the generated code must be compiled and
	installed. For this purpose, open a terminal, enter the output directory
	\begin{code}
	<PATH_to_SARAH>/Output/TMSSM/EWSB/WHIZARD_Omega/
	\end{code}
	and run
	%
	\begin{code}
	./configure
	make install
	\end{code}
	%
	By default, the last command installs the compiled model into \verb".whizard"
	in current user's home directory where it is automatically picked up by
	\whizard. Alternative installation paths can be specified using the
	\verb"--prefix" option to \whizard.
	%
	\begin{code}
	./configure --prefix=/path/to/installation/prefix
	\end{code}
	%
	If the files are installed into the \whizard\
	installation prefix, the program will also pick them up automatically, while
	{\whizard}'s \verb"--localprefix" option must be used to communicate any other
	choice to \whizard. In case \whizard\ is not available in the binary search
	path, the \verb"WO_CONFIG" environment variable can be used to point
	\verb"configure" to the binaries
	%
	\begin{code}
	./configure WO_CONFIG=/path/to/whizard/binaries
	\end{code}
	%
	More information on the available options and their syntax can be obtained with
	the
	\verb"--help" option.

	After the model is compiled it can be used in \whizard\ as
	\begin{code}
	model = tmssm_sarah
	\end{code}



	\subsection{Linking \spheno\ and \whizard}
	As mentioned above, the user can also use \spheno\ to generate spectra
	for its models. This is done by means of \fortran\ code for \spheno,
	exported from \sarah. To do so, the user has to apply the command
	\verb"MakeSPheno[]". For more details
	about the options of this command and how to compile and use the \spheno\ output,
	we refer to the \sarah\ manual. \\
	As soon as the \spheno\ version for the given model is ready it can be used to
	generate files with all necessary numerical values for the parameters in a format
	which is understood by \whizard. For this purpose, the corresponding flag in the
	Les Houches input file of \spheno\ has to be turned on:
	\begin{code}
	Block SPhenoInput # SPheno specific input
	...
	75 1 # Write WHIZARD files
	\end{code}
	Afterwards, \spheno\ returns not only the spectrum file in the
	standard SUSY Les Houches accord (SLHA) format (for more details about
	the SLHA and the \whizard\ SLHA interface cf. Sec.~\ref{sec:slha}),
	but also an additional file called \verb"WHIZARD.par.TMSSM" for our example.
	This file can be used
	in the \sindarin\ input file via
	\begin{code}
	include ("WHIZARD.par.TMSSM")
	\end{code}

	%%%%%

	\subsection{BSM Toolbox}

	A convenient way to install \sarah\ together with \whizard, \spheno\
	and some other codes are the \ttt{BSM Toolbox} scripts
	\footnote{Those script have been published
	under the name SUSY Toolbox but \sarah\ is with version 4 no longer
	restricted to SUSY models}~\cite{Staub:2011dp}. These scripts are
	available at
	\begin{center}
	\url{https://sarah.hepforge.org/Toolbox.html}
	\end{center}
	The \ttt{Toolbox} provides two scripts. First, the \verb"configure" script is
	used via
	\begin{code}
	toolbox-src-dir> mkdir build
	toolbox-src-dir> cd build
	toolbox-src-dir> ../configure
	\end{code}
	%
	The \verb"configure" script checks for the requirements of the
	different packages and downloads all codes. All downloaded archives will
	be placed in the \verb"tarballs" subdirectory of the directory containing the
	\verb"configure" script.
	Command line options can be used to disable specific packages and to point the
	script to custom locations of compilers and of the \Mathematica\ kernel; a full
	list of those can be obtained by calling \verb"configure" with the \verb"--help"
	option.

	After \verb"configure" finishes successfully, \verb"make" can be called to build
	all configured packages
	%
	\begin{code}
	toolbox-build-dir> make
	\end{code}

	\verb"configure" creates also the second script which automates the implementation
	of a new model into all packages. The \verb"butler" script takes as argument the
	name of the model in \sarah, e.g.
	\begin{code}
	> ./butler TMSSM
	\end{code}
	The \verb"butler" script runs \sarah\ to get the output in the same
	form as the \whizard/\oMega\
	model files and the code for \spheno. Afterwards, it installs the
	model in all packages and compiles the new \whizard/\oMega\ model
	files as well as the new \spheno\ module.

	%%%%%
	\newpage

	\section{New physics models via \FeynRules}

	In this section, we present the interface between the external tool
	\FeynRules\ \cite{Christensen:2008py,Christensen:2009jx,Duhr:2011se}
	and \whizard. \FeynRules\ is a
	\Mathematica~\cite{mathematica} package that allows to derive
	Feynman rules from any perturbative quantum field theory-based Lagrangian
	in an automated way. It can be downloaded from
	\begin{center}
	\url{http://feynrules.irmp.ucl.ac.be/}
	\end{center}
	The input provided by the user is threefold and consists
	of the Lagrangian defining the model, together with the definitions of
	all the
	particles and parameters that appear in the model.
	Once this information is provided, \FeynRules\ can perform basic checks
	on the sanity of the implementation (e.g. hermiticity, normalization
	of the quadratic terms), and finally computes all the interaction
	vertices associated with the model and store them in an internal
	format for later processing. After the Feynman rules have been
	obtained, \FeynRules\ can export the interaction vertices to \whizard\
	via a dedicated interface~\cite{Christensen:2010wz}. The interface
	checks whether all the vertices are compliant with the structures
	supported by \whizard's
	matrix element generator \oMega, and discard them in the case
	they are not supported. The output of the interface consists of a set
	of files organized in a single directory which can be injected into
	\whizard/\oMega\ and used as any other built-in models. Together with
	the model files, a framework is created which allows to communicate
	the new models to \whizard\ in a well defined way, after which
	step the model can be used exactly like the built-in ones.
	This specifically means that the user is not required to
	manually modify the code of \whizard/\oMega, the models created by the
	interface can be used directly without any further user intervention.
	We first describe the installation and general usage of the interface,
	and then list the general properties like the supported particle
	types, color quantum numbers and Lorentz structures as well as types
	of gauge interactions.

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\subsection{Installation and Usage of the \whizard-\FeynRules\ interface}
	\label{sec:interface-usage}

	\paragraph{{\bf Installation and basic usage:}}
	%
	From \FeynRules\ version 1.6.0 onward, the interface to \whizard\ is
	part of the \FeynRules\ distribution\footnote{Note that though the
	main interface of \FeynRules\ to \whizard\ is for the most recent
	\whizard\ release, but also the legacy branch
	\whizard\ttt{1} is supported.}. In addition, the latest version
	of the interface can be downloaded from the \whizard\ homepage on
	\ttt{HepForge}. There you can also find an installer that can be used
	to inject the interface into an existing \FeynRules\
	installation (which allows to use the interface with the \FeynRules\
	release series1.4.x where it is not part of the package).

	Once installed, the interface can be called and used in the same way
	\FeynRules' other interfaces described
	in~\cite{Christensen:2008py}. The details of how to install and use
	\FeynRules\ itself can be found
	there,~\cite{Christensen:2008py,Christensen:2009jx,Duhr:2011se}. Here,
	we only describe how to use the interface to inject new models into
	\whizard. For example, once the \FeynRules\ environment has been
	initialized and a model has been loaded, the command
	\begin{code}
	WriteWOOutput[L]
	\end{code}
	will call the \ttt{FeynmanRules} command to extract the Feynman
	rules from the Lagrangian \ttt{L}, translate them together with the
	model data and finally write the files necessary for using the model
	within \whizard\ to an output directory (the name of which is inferred
	from the model name by default). Options can be added for further
	control over the translation process (see
	Sec.~\ref{app:interface-options}). Instead of using a Lagrangian, it
	is also possible to call the interface on a pure vertex list. For
	example, the following command
	\begin{code}
	WriteWOOutput[Input -> list]
	\end{code}
	will directly translate the vertex list \ttt{list}. Note that this
	vertex list must be given in flavor-expanded form in order for the
	interface to process it correctly.

	The interface also supports the \ttt{WriteWOExtParams} command
	described in~\cite{Christensen:2008py}. Issuing
	\begin{code}
	WriteWOExtParams[filename]
	\end{code}
	will write a list of all the external parameters to
	\ttt{filename}. This is done in the form of a \sindarin\
	script. The only option accepted by the command above is the target
	version of \whizard, set by the option \ttt{WOWhizardVersion}.

	During execution, the interface will print out a series of
	messages. It is highly advised to carefully read through this output
	as it not only summarizes the settings and the location of the output
	files, but also contains information on any skipped vertices or
	potential incompatibilities of the model with \whizard.

	After the interface has run successfully and written the model files to the
	output directory, the model must be imported into \whizard. For doing
	so, the model files have to be compiled and can then be installed
	independently of \whizard. In the simplest scenario, assuming that the
	output directory is the current working directory and that the
	\whizard\ binaries can be found in the current \ttt{\$\{PATH\}},
	the installation is performed by simply executing
	\begin{code}
	./configure~\&\&~make clean~\&\&~make install
	\end{code}

	This will compile the model and install it into the directory
	\ttt{\$\{HOME\}/.whizard}, making it fully available to \whizard\
	without any further intervention. The build system can be adapted to
	more complicated cases through several options to the
	\ttt{configure} which are listed in the \ttt{INSTALL} file
	created in the output directory. A detailed explanation of all options
	can be found in Sec.~\ref{app:interface-options}.

	\paragraph{\bf Supported fields and vertices:}

	The following fields are currently supported by the interface:
	scalars, Dirac and Majorana fermions, vectors and symmetric tensors.
	The set of accepted operators, the full list of which can be found in
	Tab.~\ref{tab-operators}, is a subset of all the operators supported
	by \oMega. While still limited, this list is sufficient for a large
	number of BSM models. In addition, a future version of
	\whizard/\oMega\ will support the definition of completely general
	Lorentz structures in the model, allowing the interface to
	translate all interactions handled by \FeynRules. This will be done by
	means of a parser within \oMega\ of the \ttt{UFO} file format for
	model files from \FeynRules.

	\begin{table*}[!t]
	\centerline{\begin{tabular}{\|c\|c\|}
	\hline Particle spins & Supported Lorentz structures \\\hline\hline
	FFS & \parbox{0.7\textwidth}{\raggedright
	All operators of dimension four are supported.
	\strut}\\\hline
	FFV & \parbox[t]{0.7\textwidth}{\raggedright
	All operators of dimension four are
	supported.
	\strut}\\\hline
	SSS & \parbox{0.7\textwidth}{\raggedright
	All dimension three interactions are supported.
	\strut}\\\hline
	SVV & \parbox[t]{0.7\textwidth}{\raggedright
	Supported operators:\\
	\mbox{}\hspace{5ex}$\begin{aligned}
	\text{dimension 3:} & \quad\mathcal{O}_3 = V_1^\mu V_{2\mu}\phi \mbox{}\\
	\text{dimension 5:} & \quad\mathcal{O}_5 = \phi
	\left(\partial^\mu V_1^\nu - \partial^\nu V_1^\mu\right)
	\left(\partial_\mu V_{2\nu} - \partial_\nu V_{2\mu}\right)
	\end{aligned}$\\
	Note that $\mathcal{O}_5$ generates the effective gluon-gluon-Higgs couplings obtained by integrating out heavy quarks.
	\strut}\\\hline
	SSV & \parbox[t]{0.7\textwidth}{\raggedright
	$\left(\phi_1\partial^\mu\phi_2 - \phi_2\partial^\mu\phi_1\right)V_\mu\;$
	type interactions are supported.
	\strut}\\\hline
	SSVV & \parbox{0.7\textwidth}{\raggedright
	All dimension four interactions are supported.
	\strut}\\\hline
	SSSS & \parbox{0.7\textwidth}{\raggedright
	All dimension four interactions are supported.
	\strut}\\\hline
	VVV & \parbox[t]{0.7\textwidth}{\raggedright
	All parity-conserving dimension four operators are supported, with
	the restriction that non-gauge interactions may be split into
	several vertices and can only be handled if all three fields are
	mutually different.\strut
	\strut}\\\hline
	VVVV & \parbox[t]{0.7\textwidth}{\raggedright
	All parity conserving dimension four operators are supported.
	\strut}\\\hline
	TSS, TVV, TFF & \parbox[t]{0.7\textwidth}{\raggedright
	The three point couplings in the Appendix of Ref.\
	\cite{Han:1998sg} are supported.
	\strut}\\\hline
	\end{tabular}}
	\caption{All Lorentz structures currently supported by the
	\whizard-\FeynRules\ interface, sorted with respect to the spins of
	the particles. ``S'' stands for scalar, ``F'' for fermion (either
	Majorana or Dirac) and ``V'' for vector.}
	\label{tab-operators}
	\end{table*}

	\paragraph{\bf Color:}
	%
	Color is treated in \oMega\ in the color flow decomposition,
	with the flow structure being implicitly determined from
	the representations of the particles present at the vertex. Therefore, the
	interface has to strip the color structure from the vertices derived by
	\FeynRules\ before writing them out to the model files.
	While this process is straightforward for all color structures which
	correspond only to a single flow assignment, vertices with several
	possible flow configurations must be treated with care in order to
	avoid mismatches between the flows assigned by \oMega\ and those
	actually encoded in the couplings. To this end, the interface derives
	the color flow decomposition from the color structure determined by
	\FeynRules\ and rejects all vertices which would lead to a wrong flow
	assignment by \oMega\ (these rejections are accompanied by warnings
	from the interface)\footnote{For the old \whizard\ttt{1} legacy
	branch, there was a maximum number of external color flows that had
	to explicitly specified. Essentially, this is $n_8 - \frac{1}{2}n_3$
	where $n_8$ is the maximum number of external color octets and $n_3$
	is the maximum number of external triplets and antitriplets. This
	can be set in the \whizard/\FeynRules\ interface by the
	\ttt{WOMaxNcf} command, whose default is \ttt{4}.}.

	At the moment, the $SU(3)_C$ representations supported by
	both \whizard\ and the interface are singlets ($1$), triplets ($3$),
	antitriplets ($\bar{3}$) and octets ($8$). Tab.~\ref{tab:su3struct}
	shows all combinations of these representations which can
	form singlets together with the support status of the respective color
	structures in \whizard\ and the interface. Although the supported
	color structures do not comprise all possible singlets, the list is
	sufficient for a large number of SM extensions. Furthermore, a future
	revision of \whizard/\oMega\ will allow for explicit color flow
	assignments, thus removing most of the current restrictions.

	\begin{table*}
	\centerline{\begin{tabular}{\|c\|c\|}
	\hline $SU(3)_C$ representations &
	Support status
	\\\hline\hline
	\parbox[t]{0.2\textwidth}{
	\centerline{\begin{tabular}[t]{lll}
	$111,\quad$ & $\bar{3}31,\quad$ & $\bar{3}38,$ \\
	$1111,$ & $\bar{3}311,$ & $\bar{3}381$
	\end{tabular}}} &
	\parbox[t]{0.7\textwidth}{\raggedright\strut Fully supported by the interface\strut}
	\\\hline
	$888,\quad 8881$ &
	\parbox{0.7\textwidth}{\raggedright\strut Supported only if at least two of the octets
	are identical particles.\strut}
	\\\hline
	$881,\quad 8811$ &
	\parbox{0.7\textwidth}{\raggedright\strut Fully supported by the
	interface\footnote{%
	Not available in version 1.95 and earlier. Note that in order to
	use such couplings in 1.96/97, the
	\oMega\ option \ttt{2g} must be added to the process definition
	in \ttt{whizard.prc}.}.\strut}
	\\\hline
	$\bar{3}388$ &
	\parbox{0.7\textwidth}{\raggedright\strut Supported only if the octets
	are identical
	particles.\strut}
	\\\hline
	$8888$ &
	\parbox{0.7\textwidth}{\raggedright\strut The only supported flow structure is
	\begin{equation*}
	\parbox{21mm}{\includegraphics{flow4}}\cdot\;\Gamma(1,2,3,4)
	\quad+\quad \text{all acyclic permutations}
	\end{equation*}
	where $\Gamma(1,2,3,4)$ represents the Lorentz structure associated with the
	first flow.\strut}
	\\\hline
	\parbox[t]{0.2\textwidth}{
	\centerline{\begin{tabular}[t]{lll}
	$333,\quad$ & $\bar{3}\bar{3}\bar{3},\quad$ & $3331$\\
	$\bar{3}\bar{3}\bar{3}1,$ & $\bar{3}\bar{3}33$
	\end{tabular}}} &
	\parbox[t]{0.7\textwidth}{\raggedright\strut Unsupported (at the
	moment)\strut}
	\\\hline
	\end{tabular}}
	\caption{All possible combinations of three or four $SU(3)_C$
	representations supported by \FeynRules\ which can be used to build singlets,
	together with the support status of the corresponding color structures in
	\whizard\ and the interface.}
	\label{tab:su3struct}
	\end{table*}

	\paragraph{\bf Running $\alpha_S$:}

	While a running strong coupling is fully supported by the interface, a
	choice has to be made which quantities are to be reevaluated when the
	strong coupling is evolved. By default \ttt{aS}, \ttt{G} (see
	Ref.~\cite{Christensen:2008py} for the nomenclature regarding
	the QCD coupling) and any vertex factors depending on them are evolved.
	The list of internal parameters that are to be recalculated (together
	with the vertex factors depending on them) can be
	extended (beyond \ttt{aS} and \ttt{G}) by using
	the option \ttt{WORunParameters} when calling the
	interface~\footnote{As the legacy branch, \whizard\ttt{1}, does not
	support a running strong coupling, this is also vetoed by the
	interface when using \whizard \ttt{1.x}.}.

	\paragraph{\bf Gauge choices:}
	\label{sec:gauge-choices}

	The interface supports the unitarity, Feynman and $R_\xi$ gauges. The choice of
	gauge must be communicated to the interface via the option \ttt{WOGauge}.
	Note that massless gauge bosons are always treated in Feynman gauge.

	If the selected gauge is Feynman or $R_\xi$, the interface can
	automatically assign the proper masses to the Goldstone bosons. This behavior is
	requested by using the \ttt{WOAutoGauge} option. In the $R_\xi$
	gauges, the symbol representing the gauge $\xi$ must be communicated to the
	interface by using the \ttt{WOGaugeSymbol} option (the symbol is
	automatically introduced into the list of external
	parameters if \ttt{WOAutoGauge} is
	selected at the same time). This feature can be used to automatically extend
	models implemented in Feynman gauge to the $R_\xi$ gauges.

	Since \whizard\ (at least until the release series 2.3) is a
	tree-level tool working with helicity amplitudes, the ghost sector is
	irrelevant for \whizard\ and hence dropped by the interface.

	\subsection{Options of the \whizard-\FeynRules\ interface}
	\label{app:interface-options}

	In the following we present a comprehensive list of all the options accepted by
	\ttt{WriteWOOutput}. Additionally, we note that all options of the
	\FeynRules\ command \ttt{FeynmanRules} are accepted by
	\ttt{WriteWOOutput}, which passes them on to \ttt{FeynmanRules}.

	\begin{description}
	\item[\ttt{Input}]\mbox{}\\
	An optional vertex list to use instead of a Lagrangian (which can then be
	omitted).
	%
	\item[\ttt{WOWhizardVersion}]\mbox{}\\
	Select the \whizard\ version for which code is to be generated.
	The currently available choices are summarized in
	Tab.~\ref{tab-wowhizardversion}.
	%%
	\begin{table}
	\centerline{\begin{tabular}{\|l\|l\|}
	\hline \ttt{WOWhizardVersion} & \whizard\ versions supported
	\\\hline\hline
	\ttt{"2.0.3"} (default) & 2.0.3+ \\\hline
	\ttt{"2.0"} & 2.0.0 -- 2.0.2 \\\hline\hline
	\ttt{"1.96"} & 1.96+ \qquad (deprecated) \\\hline
	\ttt{"1.93"} & 1.93 -- 1.95 \qquad (deprecated) \\\hline
	\ttt{"1.92"} & 1.92 \qquad (deprecated) \\\hline
	\end{tabular}}
	\caption{Currently available choices for the \ttt{WOWhizardVersion} option,
	together with the respective \whizard\ versions supported by them.}
	\label{tab-wowhizardversion}
	\end{table}
	%%
	This list will expand as the program evolves. To get a summary
	of all choices available in a particular version of the interface, use
	the command
	\ttt{?WOWhizardVersion}.
	%
	\item[\ttt{WOModelName}]\mbox{}\\
	The name under which the model will be known to
	\whizard\footnote{For versions 1.9x, model names must start
	with ``\ttt{fr\_}'' if they are to be picked up by \whizard\
	automatically.}. The default is determined from the \FeynRules\
	model name.
	%
	\item[\ttt{Output}]\mbox{}\\
	The name of the output directory. The default is determined from the
	\FeynRules\ model name.
	%
	\item[\ttt{WOGauge}]\mbox{}\\
	Gauge choice (\emph{cf.} Sec.~\ref{sec:gauge-choices}).
	Possible values are: \ttt{WOUnitarity} (default),
	\ttt{WOFeynman}, \ttt{WORxi}
	%
	\item[\ttt{WOGaugeParameter}]\mbox{}\\
	The external or internal parameter representing the gauge $\xi$ in
	the $R_\xi$ gauges (\emph{cf.} Sec.~\ref{sec:gauge-choices}). Default:
	\ttt{Rxi}
	%
	\item[\ttt{WOAutoGauge}]\mbox{}\\
	Automatically assign the Goldstone boson masses in the Feynman and $R_\xi$
	gauges and automatically append the symbol for $\xi$ to the parameter list in
	the $R_\xi$ gauges. Default: \ttt{False}
	%
	\item[\ttt{WORunParameters}]\mbox{}\\
	The list of all internal parameters which will be recalculated if $\alpha_S$ is
	evolved (see above)\footnote{Not available for versions older than
	2.0.0}. Default: \mbox{\ttt{\{aS, G\}}}
	%
	\item[\ttt{WOFast}]\mbox{}\\
	If the interface drops vertices which are supported, this option can be
	set to \ttt{False} to enable some more time consuming checks which might aid
	the identification. Default: \ttt{True}
	%
	\item[\ttt{WOMaxCouplingsPerFile}]\mbox{}\\
	The maximum number of couplings that are written to a single \fortran\
	file. If compilation takes too long or fails, this can be
	lowered. Default: \ttt{500}
	%
	\item[\ttt{WOVerbose}]\mbox{}\\
	Enable verbose output and in particular more extensive information on any
	skipped vertices. Default: \ttt{False}
	\end{description}

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\subsection{Validation of the interface}

	The output of the interface has been extensively
	validated. Specifically, the integrated cross sections for all
	possible $2\rightarrow 2$ processes in the \FeynRules\ SM, the MSSM
	and the Three-Site Higgsless Model have been compared between
	\whizard, \madgraph, and \CalcHep, using the respective \FeynRules\
	interfaces as well as the in-house implementations of these models
	(the Three-Site Higgsless model not being available in \madgraph).
	Also, different gauges have been checked for \whizard\ and \CalcHep.
	In all comparisons, excellent agreement within the Monte Carlo errors
	was achieved. The detailed comparison including examples of the
	comparison tables can be found in~\cite{Christensen:2010wz}.

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\subsection{Examples for the \whizard-/\FeynRules\ interface}

	Here, we will use the Standard Model, the MSSM and the Three-Site
	Higgsless Model as prime examples to explain the usage of the
	interface. Those are the models that have been used in the validation
	of the interface in~\cite{Christensen:2010wz}. The examples are
	constructed to show the application of the different options of the
	interface and to serve as a starting point for the generation of the
	user's own \whizard\ versions of other \FeynRules\ models.

	\subsubsection{\whizard-\FeynRules\ example: Standard
	Model}\label{sec:usageSM}

	To start off, we will create {\sc Whizard} 2 versions of the Standard
	Model as implemented in \FeynRules\ for different gauge choices.

	\paragraph{SM: Unitarity Gauge}

	In order to invoke \FeynRules, we change to the corresponding
	directory and load the program in \Mathematica\ via
	\begin{code}
	$FeynRulesPath =
	SetDirectory["<path-to-FeynRules>"];
	<<FeynRules`
	\end{code}
	%$
	The model is loaded by
	\begin{code}
	LoadModel["Models/SM/SM.fr"];
	FeynmanGauge = False;
	\end{code}
	Note that the second line is required to switch the Standard
	Model to Unitarity gauge as opposed to Feynman gauge (which is the default).
	Generating a \whizard\ model is now simply done by
	\begin{code}
	WriteWOOutput[LSM];
	\end{code}
	After invokation, the interface first gives a short summary of the setup
	\begin{code}
	Short model name is "fr_standard_model"
	Gauge: Unitarity
	Generating code for WHIZARD / O'Mega
	version 2.0.3
	Maximum number of couplings per FORTRAN
	module: 500
	Extensive lorentz structure checks disabled.
	\end{code}

	Note that, as we have not changed any options, those settings represent the
	defaults. The output proceeds with the calculation of the Feynman rules from the
	Standard Model Lagrangian \verb?LSM?. After the rules have been derived, the
	interface starts generating output and tries to match the vertices to
	their \whizard/\oMega\ counterparts.
	\begin{code}
	10 of 75 vertices processed...
	20 of 75 vertices processed...
	30 of 75 vertices processed...
	40 of 75 vertices processed...
	50 of 75 vertices processed...
	60 of 75 vertices processed...
	70 of 75 vertices processed...
	processed a total of 75 vertices, kept 74
	of them and threw away 1, 1 of which
	contained ghosts or goldstone bosons.
	\end{code}
	The last line of the above output is particularily interesting, as it informs us
	that everything worked out correctly: the interface was able to match all
	vertices, and the only discarded vertex was the QCD ghost interaction.
	After the interface has finished running, the model files in the output
	directory are ready to use and can be compiled using the procedure described in
	the previous section.

	%%%%%

	\paragraph{SM: Feynman and $R_\xi$ gauges}

	As the Standard Model as implemented in \FeynRules\ also supports Feynman
	gauge, we can use the program to generate a Feynman gauge version of the model.
	Loading \FeynRules\ and the model proceeds as above, with the only
	difference being the change
	\begin{code}
	FeynmanGauge = True;
	\end{code}
	In order to inform the interface about the modified gauge, we have to
	add the option \verb?WOGauge?
	\begin{code}
	WriteWOOutput[LSM, WOGauge -> WOFeynman];
	\end{code}
	The modified gauge is reflected in the output of the interface
	\begin{code}
	Short model name is "fr_standard_model"
	Gauge: Feynman
	Generating code for WHIZARD / O'Mega
	version 2.0.3
	Maximum number of couplings per FORTRAN
	module: 500
	Extensive lorentz structure checks disabled.
	\end{code}
	The summary of the vertex identification now takes the following form
	\begin{code}
	processed a total of 163 vertices, kept 139
	of them and threw away 24, 24 of which
	contained ghosts.
	\end{code}
	Again, this line tells us that there were no problems --- the only
	discarded interactions involved the ghost sector which is irrelevant
	for the tree-level part of \whizard.

	For a tree-level calculation, the only difference between the
	different gauges from the perspective of the interface are the gauge
	boson propagators and the Goldstone boson masses. Therefore, the
	interface can automatically convert a model in Feynman gauge to a
	model in $R_\xi$ gauge. To this end, the call to the interface must be
	changed to
	\begin{code}
	WriteWOOutput[LSM, WOGauge -> WORxi,
	WOAutoGauge -> True];
	\end{code}
	The \verb?WOAutoGauge? argument instructs the interface to
	automatically
	\begin{enumerate}
	\item Introduce a symbol for the gauge parameter $\xi$ into the
	list of external parameters
	\item Generate the Goldstone boson masses from those of the associated
	gauge bosons (ignoring the values provided by \FeynRules)
	\end{enumerate}
	The modified setup is again reflected in the interface output
	\begin{code}
	Short model name is "fr_standard_model"
	Gauge: Rxi
	Gauge symbol: "Rxi"
	Generating code for WHIZARD / O'Mega
	version 2.0.3
	Maximum number of couplings per FORTRAN
	module: 500
	Extensive lorentz structure checks disabled.
	\end{code}
	Note the default choice \verb?Rxi? for the name of the $\xi$ parameter
	-- this can be modified via the option \verb?WOGaugeParameter?.

	While the \verb?WOAutoGauge? feature allows to generate $R_\xi$ gauged models
	from models implemented in Feynman gauge, it is of course also possible to use
	models genuinely implemented in $R_\xi$ gauge by setting this parameter to
	\verb?False?. Also, note that the choice of gauge only affects the propagators
	of massive fields. Massless gauge bosons are always treated in Feynman
	gauge.

	\paragraph{Compilation and usage}

	In order to compile and use the freshly generated model files, change to the
	output directory which can be determined from the interface output (in this
	example, it is \verb?fr_standard_model-WO?). Assuming that \whizard\ is
	available in the binary search path, compilation and installation proceeds as
	described above by executing
	\begin{code}
	./configure && make && make install
	\end{code}
	The model is now ready and can be used similarly to the builtin
	\whizard\ models. For example, a minimal \whizard\ input file for
	calculating the $e^+e^- \longrightarrow W^+W^-$ scattering cross
	section in the freshly generated model would look like
	\begin{code}
	model = fr_standard_model
	process test = "e+", "e-" -> "W+", "W-"
	sqrts = 500 GeV
	integrate (test)
	\end{code}

	%%%%%

	\subsubsection{\whizard/\FeynRules\ example: MSSM}
	In this Section, we illustrate the usage of the interface between {\sc
	FeynRules} and {\sc Whizard} in the context of the MSSM. All the
	parameters of the model are then ordered in Les Houches blocks and
	counters following the SUSY Les Houches Accord (SLHA)
	\cite{Skands:2003cj,AguilarSaavedra:2005pw,Allanach:2008qq} (cf. also
	Sec.~\ref{sec:slha}).

	After having downloaded the model
	from the \FeynRules\ website, we store it in a new directory, labelled
	\verb"MSSM", of the model library of the local installation of
	\FeynRules. The model can then be loaded in \Mathematica\ as in the
	case of the SM example above
	\begin{code}
	$FeynRulesPath =
	SetDirectory["<path-to-FeynRules>"];
	<<FeynRules`
	LoadModel["Models/MSSM/MSSM.fr"];
	FeynmanGauge = False;
	\end{code}
	%$
	We are again adopting unitarity gauge.

	The number of vertices associated to supersymmetric Lagrangians is in general
	very large (several thousands). For such models with many interactions,
	it is recommended to first extract all the Feynman rules of the theory before
	calling the interface between \whizard\ and \FeynRules.
	The reason is related to the efficiency of the interface which takes
	a lot of time in the extraction of the interaction vertices. In the
	case one wishes to study the phenomenology of several benchmark
	scenarios, this procedure, which is illustrated below,
	allows to use the interface in the best way. The Feynman rules
	are derived from the Lagrangian once and for all and then reused by the
	interface for each set of \whizard\ model files to be produced,
	considerably speeding up the generation of multiple model files
	issued from a single Lagrangian. In addition, the scalar potential of
	supersymmetric theories contains a large set of four scalar
	interactions, in general irrelevant for collider phenomenology. These
	vertices can be neglected with the help of the
	\verb"Exclude4Scalars->True" option of both interface commands
	\verb"FeynmanRules" and \verb"WriteWOOutput". The Feynman
	rules of the MSSM are then computed within the \Mathematica\ notebook
	by
	\begin{code}
	rules = FeynmanRules[lag,
	Exclude4Scalars->True, FlavorExpand->True];
	\end{code}
	where \verb'lag' is the variable containing the Lagrangian.

	By default, all the parameters of the model are set to the value of
	\ttt{1}. A complete parameter \ttt{{\em <slha\_params>}.dat} file
	must therefore be loaded. Such a parameter file can be downloaded from
	the \FeynRules\ website or created by hand by the user, and loaded
	into \FeynRules\ as
	\begin{code}
	ReadLHAFile[Input -> "<slha_params>.dat"];
	\end{code}
	This command does not reduce the size of the model output by removing
	vertices with vanishing couplings. However, if desired, this task
	could be done with the \ttt{LoadRestriction} command (see Ref.\
	\cite{Fuks:2012im} for details).

	The vertices are exported to \whizard\ by the command
	\begin{code}
	WriteWOOutput[Input -> rules];
	\end{code}
	Note that the numerical values of the parameters of the model can be
	modified directly from \whizard, without having to generate a second
	time the \whizard\ model files from \FeynRules. A \sindarin\ script is
	created by the interface with the help of the instruction
	\begin{code}
	WriteWOExtParams["parameters.sin"];
	\end{code}
	and can be further modified according to the needs of the user.

	\subsubsection{\whizard-\FeynRules\ example: Three-Site Higgsless Model}


	The Three-Site Higgsless model or Minimal Higgsless model (MHM) has
	been implemented into \ttt{LanHEP}~\cite{He:2007ge}, \FeynRules\
	and independently into \whizard~\cite{Speckner:2010zi},
	and the collider phenomenology has been studied by making use of these
	implementations \cite{He:2007ge,Ohl:2010zf,Speckner:2010zi}.
	Furthermore, the independent implementations in \FeynRules\ and
	directly into {\sc Whizard} have been compared and found to
	agree~\cite{Christensen:2010wz}. After the discovery of a Higgs boson
	at the LHC in 2012, such a model is not in good agreement with
	experimental data any more. Here, we simply use it as a guinea pig to
	describe the handling of a model with non-renormalizable interactions
	with the \FeynRules\ interface, and discuss how to generate \whizard\
	model files for it. The model has been implemented in Feynman gauge as
	well as unitarity gauge and contains the variable \verb\|FeynmanGauge\|
	which can be set to \verb\|True\| or \verb\|False\|. When set to
	\verb\|True\|, the option \verb\|WOGauge-> WOFeynman\| must be used, as
	explained in~\cite{Christensen:2010wz}. $R_\xi$ gauge can also be
	accomplished with this model by use of the options
	\verb\|WOGauge -> WORxi\| and \verb?WOAutoGauge -> True?.

	Since this model makes use of a nonlinear sigma field of the form
	\begin{equation}
	\Sigma = 1 + i\pi - \frac{1}{2}\pi^2+\cdots
	\end{equation}
	many higher dimensional operators are included in the model which are
	not currently not supported by \whizard. Even for a future release of
	\whizard\ containing general Lorentz structures in interaction
	vertices, the user would be forced to expand the series only up to a
	certain order. Although \whizard\ can reject these vertices
	and print a warning message to the user, it is preferable to remove
	the vertices right away in the interface by the option
	\verb\|MaxCanonicalDimension->4\|. This is passed to the command
	\verb\|FeynmanRules\| and restricts the Feynman rules to those of
	dimension four and smaller\footnote{\ttt{MaxCanonicalDimension} is an
	option of the \ttt{FeynmanRules} function rather than of the
	interface, itself. In fact, the interface accepts all the options of
	{\tt FeynmanRules} and simply passes them on to the latter.}.

	As the use of different gauges was already illustrated in the SM
	example, we discuss the model only in Feynman gauge here. We load
	\FeynRules:
	\begin{code}
	$FeynRulesPath =
	SetDirectory["<path-to-FeynRules>"];
	<<FeynRules`
	\end{code}
	%$
	The MHM model itself is then loaded by
	\begin{code}
	SetDirectory["<path-to-MHM>"];
	LoadModel["3-Site-particles.fr",
	"3-Site-parameters.fr",
	"3-Site-lagrangian.fr"];
	FeynmanGauge = True;
	\end{code}
	where \verb\|<path-to-MHM>\| is the path to the directory where the MHM
	model files are stored and where the output of the \whizard\
	interface will be written. The \whizard\ interface is then initiated:
	\begin{code}
	WriteWOOutput[LGauge, LGold, LGhost, LFermion,
	LGoldLeptons, LGoldQuarks,
	MaxCanonicalDimension->4,
	WOGauge->WOFeynman, WOModelName->"fr_mhm"];
	\end{code}
	where we have also made use of the option \verb\|WOModelName\| to change
	the name of the model as seen by \whizard. As in the case of the SM,
	the interface begins by writing a short informational message:
	\begin{code}
	Short model name is "fr_mhm"
	Gauge: Feynman
	Generating code for WHIZARD / O'Mega
	version 2.0.3
	Automagically assigning Goldstone
	boson masses...
	Maximum number of couplings per FORTRAN
	module: 500
	Extensive lorentz structure checks disabled.
	\end{code}
	After calculating the Feynman rules and processing the vertices, the
	interface gives a summary:
	\begin{code}
	processed a total of 922 vertices, kept 633
	of them and threw away 289, 289 of which
	contained ghosts.
	\end{code}
	showing that no vertices were missed. The files are stored in the
	directory \verb\|fr_mhm\| and are ready to be installed and used with
	\whizard.

	%%%%%%%%%%%%%%%

	\section{New physics models via the \UFO\ file format}
	\label{sec:ufo}

	In this section, we describe how to use the {\em Universal FeynRules
	Output} (\UFO, \cite{Degrande:2011ua}) format for physics models
	inside \whizard. Please refer the manuals of e.g.~\FeynRules\ manual
	for details on how to generate a \UFO\ file for your favorite physics
	model. \UFO\ files are a collection of \python\ scripts that
	encode the particles, the couplings, the Lorentz structures, the
	decays, as well as parameters, vertices and propagators of the
	corresponding model. They reside in a directory of the exact name of
	the model they have been created from.

	If the user wants to generate events for processes from a physics
	model from a \UFO\ file, then this directory of scripts generated by
	\FeynRules\ is immediately available if it is a subdirectory of the working
	directory of \whizard. The directory name will be taken as the model
	name. (The \UFO-model file name must not start with a
	non-letter character, i.e. especially not a number. In case such a
	file name wants to be used at all costs, the model name in the
	\sindarin\ script has to put in quotation marks, but this is not
	guaranteed to always work.) Then, a \UFO\ model named, e.g.,
	\ttt{test\_model} is accessed by an extra \ttt{ufo} tag in the model
	assignment:
	\begin{Code}
	model = test_model (ufo)
	\end{Code}

	If desired, \whizard\ can access a directory of \UFO\ files elsewhere
	on the file system. For instance, if \FeynRules\ output resides in
	the subdirectory \ttt{MyMdl} of
	\ttt{/home/users/john/ufo}, \whizard\ can use the model
	named \ttt{MyMdl} as follows
	\begin{Code}
	model = MyMdl (ufo ('/home/users/john/my_ufo_models'))
	\end{Code}
	that is, the \sindarin\ keyword \ttt{ufo} can take an argument. Note
	however, that the latter approach can backfire --- in case just the working
	directory is packed and archived for future reference.

	%%%%%%%%%%%%%%%



	\clearpage

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\appendix

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{\sindarin\ Reference}

	In the \sindarin\ language, there are certain pre-defined constructors or
	commands that cannot be used in different context by the user, which
	are e.g. \ttt{alias}, \ttt{beams}, \ttt{integrate}, \ttt{simulate} etc.
	A complete list will be given below. Also units are fixed, like
	\ttt{degree}, \ttt{eV}, \ttt{keV},
	\ttt{MeV}, \ttt{GeV}, and \ttt{TeV}. Again, these tags are locked and
	not user-redefinable. Their functionality will be listed in detail
	below, too. Furthermore, a variable with a preceding
	question mark, ?, is a logical, while a preceding dollar, \$, denotes a
	character string variable. Also, a lot of unary and binary operators
	exist, \ttt{+ - $\backslash$ , = : => < > <= >= \^ \; () [] \{\} }
	\url{==}, as well as quotation marks, ". Note that the
	different parentheses and brackets fulfill different purposes, which
	will be explained below. Comments in a line can either be marked by a
	hash, \#, or an exclamation mark, !.

	\section{Commands and Operators}
	We begin the \sindarin\ reference with all commands, operators, functions
	and constructors.
	The list of variables (which can be set to change behavior of \whizard) can
	be found in the next section.
	\begin{itemize}
	\item
	\ttt{+} \newline
	1) Arithmetic operator for addition of integers, reals and complex
	numbers. Example: \ttt{real mm = mH + mZ} (cf. also \ttt{-}, \ttt{*},
	\ttt{/}, \ttt{\^{}}). 2) It also adds different particles for inclusive
	process containers: \ttt{process foo = e1, E1 => (e2, E2) + (e3,
	E3)}. 3) It also serves as a shorthand notation for the
	concatenation of ($\to$) \ttt{combine} operations on
	particles/subevents, e.g. \ttt{cuts = any 170 GeV < M < 180 GeV [b +
	lepton + invisible]}.
	%%%%%
	\item
	\ttt{-} \newline
	Arithmetic operator for subtraction of integers, reals and complex
	numbers. Example: \ttt{real foo = 3.1 - 5.7} (cf. also \ttt{+}, \ttt{*},
	\ttt{/}, \ttt{\^{}}).
	%%%%%
	\item
	\ttt{/} \newline
	Arithmetic operator for division of integers, reals and complex
	numbers. Example: \ttt{scale = mH / 2} (cf. also \ttt{+}, \ttt{*},
	\ttt{-}, \ttt{\^{}}).
	%%%%%
	\item
	\ttt{*} \newline
	Arithmetic operator for multiplication of integers, reals and complex
	numbers. Example: \ttt{complex z = 2 * I} (cf. also \ttt{+}, \ttt{/},
	\ttt{-}, \ttt{\^{}}).
	%%%%%
	\item
	\ttt{\^{}} \newline
	Arithmetic operator for exponentiation of integers, reals and complex
	numbers. Example: \ttt{real z = x\^{}2 + y\^{}2} (cf. also \ttt{+},
	\ttt{/}, \ttt{-}, \ttt{\^{}}).
	%%%%%
	\item
	\ttt{<} \newline
	Arithmetic comparator between values that checks for ordering
	of two values: \ttt{{\em <val1>} < {\em <val2>}} tests whether
	\ttt{{\em val1}} is smaller than \ttt{{\em val2}}. Allowed for
	integer and real values. Note that this is an exact comparison if
	\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
	it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
	\ttt{==}, \ttt{>}, \ttt{>=}, \ttt{<=})
	%%%%%
	\item
	\ttt{>} \newline
	Arithmetic comparator between values that checks for ordering
	of two values: \ttt{{\em <val1>} > {\em <val2>}} tests whether
	\ttt{{\em val1}} is larger than \ttt{{\em val2}}. Allowed for
	integer and real values. Note that this is an exact comparison if
	\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
	it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
	\ttt{==}, \ttt{>}, \ttt{>=}, \ttt{<=})
	%%%%%
	\item
	\ttt{<=} \newline
	Arithmetic comparator between values that checks for ordering
	of two values: \ttt{{\em <val1>} <= {\em <val2>}} tests whether
	\ttt{{\em val1}} is smaller than or equal \ttt{{\em val2}}. Allowed for
	integer and real values. Note that this is an exact comparison if
	\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
	it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
	\ttt{==}, \ttt{>}, \ttt{<}, \ttt{>=})
	%%%%%
	\item
	\ttt{>=} \newline
	Arithmetic comparator between values that checks for ordering
	of two values: \ttt{{\em <val1>} >= {\em <val2>}} tests whether
	\ttt{{\em val1}} is larger than or equal \ttt{{\em val2}}. Allowed for
	integer and real values. Note that this is an exact comparison if
	\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
	it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
	\ttt{==}, \ttt{>}, \ttt{<}, \ttt{>=})
	%%%%%
	\item
	\ttt{==} \newline
	Arithmetic comparator between values that checks for identity
	of two values: \ttt{{\em <val1>} == {\em <val2>}}. Allowed for
	integer and real values. Note that this is an exact comparison if
	\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
	it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{<>},
	\ttt{>}, \ttt{<}, \ttt{>=}, \ttt{<=})
	%%%%%
	\item
	\ttt{<>} \newline
	Arithmetic comparator between values that checks for
	two values being unequal: \ttt{{\em <val1>} <> {\em <val2>}}. Allowed for
	integer and real values. Note that this is an exact comparison if
	\ttt{tolerance} is set to zero. For a finite value of \ttt{tolerance}
	it is a ``fuzzy'' comparison. (cf. also \ttt{tolerance}, \ttt{==},
	\ttt{>}, \ttt{<}, \ttt{>=}, \ttt{<=})
	%%%%%
	\item
	\ttt{!} \newline
	The exclamation mark tells \sindarin\ that everything that follows in
	that line should be treated as a comment. It is the same as ($\to$)
	\ttt{\#}.
	%%%%%
	\item
	\ttt{\#} \newline
	The hash tells \sindarin\ that everything that follows in
	that line should be treated as a comment. It is the same as ($\to$)
	\ttt{!}.
	%%%%%
	\item
	\ttt{\&} \newline
	Concatenates two or more particle lists/subevents and hence acts in
	the same way as the subevent function ($\to$) \ttt{join}: \ttt{let
	@visible = [photon] \& [colored] \& [lepton] in ...}. (cf. also
	\ttt{join}, \ttt{combine}, \ttt{collect}, \ttt{extract}, \ttt{sort}).
	%%%%%
	\item
	\ttt{\$} \newline
	Constructor at the beginning of a variable name,
	\ttt{\${\em <string\_var>}}, that specifies a string variable.
	%%%%%
	\item
	\ttt{@} \newline
	Constructor at the beginning of a variable name, \ttt{@{\em
	<subevt\_var>}}, that specifies a subevent variable, e.g. \ttt{let
	@W\_candidates = combine ["mu-", "numubar"] in ...}.
	%%%%%
	\item
	\ttt{=} \newline
	Binary constructor to appoint values to commands, e.g. \ttt{{\em <command>}
	= {\em <expr>}} or \newline \ttt{{\em <command>} {\em <var\_name>} =
	{\em <expr>}}.
	%%%%%
	\item
	\ttt{\%} \newline
	Constructor that gives the percentage of a number, so in
	principle multiplies a real number by \ttt{0.01}. Example: \ttt{1.23
	\%} is equal to \ttt{0.0123}.
	%%%%%
	\item
	\ttt{:} \newline
	Separator in alias expressions for particles, e.g. \ttt{alias neutrino
	= n1:n2:n3:N1:N2:N3}. (cf. also \ttt{alias})
	%%%%%
	\item
	\ttt{;} \newline
	Concatenation operator for logical expressions: \ttt{{\em lexpr1} ;
	{\em lexpr2}}. Evaluates \ttt{{\em lexpr1}} and throws the result
	away, then evaluates \ttt{{\em lexpr2}} and returns that result. Used
	in analysis expressions. (cf. also \ttt{analysis}, \ttt{record})
	%%%%%
	\item
	\ttt{/+} \newline
	Incrementor for ($\to$) \ttt{scan} ranges, that increments additively,
	\ttt{scan {\em <num\_spec> <num>} = ({\em <lower val>} => {\em <upper
	val>} /+ {\em <step
	size>})}. E.g. \ttt{scan int i = (1 => 5 /+ 2)} scans over the values \ttt{1},
	\ttt{3}, \ttt{5}. For real ranges, it divides the interval between
	upper and lower bound into as many intervals as the incrementor
	provides, e.g. \ttt{scan real r = (1 => 1.5 /+ 0.2)} runs over
	\ttt{1.0}, \ttt{1.333}, \ttt{1.667}, \ttt{1.5}.
	%%%%%
	\item
	\ttt{/+/} \newline
	Incrementor for ($\to$) \ttt{scan} ranges, that increments additively,
	but the number after the incrementor is the number of steps, not the
	step size: \ttt{scan {\em <num\_spec> <num>} = ({\em <lower val>} =>
	{\em <upper val>}
	/+/ {\em <steps>})}. It is only available for real scan ranges, and divides
	the interval \ttt{{\em <upper val>} - {\em <lower val>}} into
	\ttt{{\em <steps>}} steps,
	e.g. \ttt{scan real r = (1 => 1.5 /+/ 3)} runs over \ttt{1.0},
	\ttt{1.25}, \ttt{1.5}.
	%%%%%
	\item
	\ttt{/-} \newline
	Incrementor for ($\to$) \ttt{scan} ranges, that increments subtractively,
	\ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>} /- {\em <step
	size>})}. E.g. \ttt{scan int i = (9 => 0 /+ 3)} scans over the values \ttt{9},
	\ttt{6}, \ttt{3}, \ttt{0}. For real ranges, it divides the interval
	between upper and lower bound into as many intervals as the incrementor
	provides, e.g. \ttt{scan real r = (1 => 0.5 /- 0.2)} runs over
	\ttt{1.0}, \ttt{0.833}, \ttt{0.667}, \ttt{0.5}.
	%%%%%
	\item
	\ttt{/*} \newline
	Incrementor for ($\to$) \ttt{scan} ranges, that increments multiplicatively,
	\ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>} /* {\em <step
	size>})}. E.g. \ttt{scan int i = (1 => 4 /* 2)} scans over the values \ttt{1},
	\ttt{2}, \ttt{4}. For real ranges, it divides the interval
	between upper and lower bound into as many intervals as the incrementor
	provides, e.g. \ttt{scan real r = (1 => 5 /* 2)} runs over
	\ttt{1.0}, \ttt{2.236} (i.e. $\sqrt{5}$), \ttt{5.0}.
	%%%%%
	\item
	\ttt{/*/} \newline
	Incrementor for ($\to$) \ttt{scan} ranges, that increments multiplicatively,
	but the number after the incrementor is the number of steps, not the
	step size: \ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>}
	/*/ {\em <steps>})}. It is only available for real scan ranges, and divides
	the interval \ttt{{\em <upper val>} - {\em <lower val>}} into \ttt{{\em <steps>}} steps,
	e.g. \ttt{scan real r = (1 => 9 /*/ 4)} runs over \ttt{1.000},
	\ttt{2.080}, \ttt{4.327}, \ttt{9.000}.
	%%%%%
	\item
	\ttt{//} \newline
	Incrementor for ($\to$) \ttt{scan} ranges, that increments by division,
	\ttt{scan {\em <num\_spec>} {\em <num>} = ({\em <lower val>} => {\em <upper val>} // {\em <step
	size>})}. E.g. \ttt{scan int i = (13 => 0 // 3)} scans over the values \ttt{13},
	\ttt{4}, \ttt{1}, \ttt{0}. For real ranges, it divides the interval
	between upper and lower bound into as many intervals as the incrementor
	provides, e.g. \ttt{scan real r = (5 => 1 // 2)} runs over
	\ttt{5.0}, \ttt{2.236} (i.e. $\sqrt{5}$), \ttt{1.0}.
	%%%%%
	\item
	\ttt{=>} \newline
	Binary operator that is used in several different contexts: 1) in
	process declarations between the particles specifying the
	initial and final state, e.g. \ttt{process {\em <proc\_name>} = {\em <in1>}, {\em <in2>}
	=> {\em <out1>}, ....}; 2) for the specification of beams when
	structure functions are applied to the beam particles, e.g. \ttt{beams
	= p, p => pdf\_builtin}; 3) for the specification of the scan range in
	the \ttt{scan {\em <var>} {\em <var\_name>} = ({\em <scan\_start>} => {\em <scan\_end>}
	{\em <incrementor>})} (cf. also \ttt{process}, \ttt{beams}, \ttt{scan})
	%%%%%
	\item
	\ttt{\%d} \newline
	Format specifier in analogy to the \ttt{C} language for the print out
	on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
	\ttt{sprintf} command. It is used for decimal integer numbers,
	e.g. \ttt{printf "one = \%d" (i)}. The difference between \ttt{\%i}
	and \ttt{\%d} does not play a role here. (cf. also \ttt{printf}, \ttt{sprintf},
	\ttt{\%i}, \ttt{\%e}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
	\ttt{\%G}, \ttt{\%s})
	%%%%%
	\item
	\ttt{\%e} \newline
	Format specifier in analogy to the \ttt{C} language for the print out
	on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
	\ttt{sprintf} command. It is used for floating-point numbers in
	standard form \ttt{[-]d.ddd e[+/-]ddd}. Usage e.g. \ttt{printf "pi =
	\%e" (PI)}. (cf. also \ttt{printf}, \ttt{sprintf},
	\ttt{\%d}, \ttt{\%i}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
	\ttt{\%G}, \ttt{\%s})
	%%%%%
	\item
	\ttt{\%E} \newline
	Same as ($\to$) \ttt{\%e}, but using upper-case letters. (cf. also
	\ttt{printf}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f},
	\ttt{\%g}, \ttt{\%F}, \ttt{\%G}, \ttt{\%s})
	%%%%%
	\item
	\ttt{\%f} \newline
	Format specifier in analogy to the \ttt{C} language for the print out
	on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
	\ttt{sprintf} command. It is used for floating-point numbers in
	fixed-point form. Usage e.g. \ttt{printf "pi =
	\%f" (PI)}. (cf. also \ttt{printf}, \ttt{sprintf},
	\ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
	\ttt{\%G}, \ttt{\%s})
	%%%%%
	\item
	\ttt{\%F} \newline
	Same as ($\to$) \ttt{\%f}, but using upper-case letters. (cf. also
	\ttt{printf}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f},
	\ttt{\%g}, \ttt{\%E}, \ttt{\%G}, \ttt{\%s})
	%%%%%
	\item
	\ttt{\%g} \newline
	Format specifier in analogy to the \ttt{C} language for the print out
	on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
	\ttt{sprintf} command. It is used for floating-point numbers in
	normal or exponential notation, whichever is more approriate. Usage
	e.g. \ttt{printf "pi = \%g" (PI)}. (cf. also \ttt{printf}, \ttt{sprintf},
	\ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f}, \ttt{\%E}, \ttt{\%F},
	\ttt{\%G}, \ttt{\%s})
	%%%%%
	\item
	\ttt{\%G} \newline
	Same as ($\to$) \ttt{\%g}, but using upper-case letters. (cf. also
	\ttt{printf}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f},
	\ttt{\%g}, \ttt{\%E}, \ttt{\%F}, \ttt{\%s})
	%%%%%
	\item
	\ttt{\%i} \newline
	Format specifier in analogy to the \ttt{C} language for the print out
	on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
	\ttt{sprintf} command. It is used for integer numbers,
	e.g. \ttt{printf "one = \%i" (i)}. The difference between \ttt{\%i}
	and \ttt{\%d} does not play a role here. (cf. \ttt{printf}, \ttt{sprintf},
	\ttt{\%d}, \ttt{\%e}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
	\ttt{\%G}, \ttt{\%s})
	%%%%%
	\item
	\ttt{\%s} \newline
	Format specifier in analogy to the \ttt{C} language for the print out
	on screen by the ($\to$) \ttt{printf} or into strings by the ($\to$)
	\ttt{sprintf} command. It is used for logical or string variables
	e.g. \ttt{printf "foo = \%s" (\$method)}. (cf. \ttt{printf}, \ttt{sprintf},
	\ttt{\%d}, \ttt{\%i}, \ttt{\%e}, \ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F},
	\ttt{\%G})
	%%%%%
	\item
	\ttt{abarn} \newline
	Physical unit, stating that a number is in attobarns ($10^{-18}$
	barn). (cf. also \ttt{nbarn}, \ttt{fbarn}, \ttt{pbarn})
	%%%%%
	\item
	\ttt{abs} \newline
	Numerical function that takes the absolute value of its argument:
	\ttt{abs ({\em <num\_val>})} yields \ttt{\|{\em
	<num\_val>}\|}. (cf. also \ttt{conjg}, \ttt{sgn}, \ttt{mod}, \ttt{modulo})
	%%%%%
	\item
	\ttt{acos} \newline
	Numerical function \ttt{asin ({\em <num\_val>})} that calculates the
	arccosine trigonometric function (inverse of \ttt{cos}) of real and
	complex numerical numbers or variables. (cf. also \ttt{sin},
	\ttt{cos}, \ttt{tan}, \ttt{asin}, \ttt{atan})
	%%%%%
	\item
	\ttt{alias} \newline
	This allows to define a collective expression for a class of
	particles, e.g. to define a generic expression for leptons, neutrinos
	or a jet as \ttt{alias lepton = e1:e2:e3:E1:E2:E3}, \ttt{alias
	neutrino = n1:n2:n3:N1:N2:N3}, and \ttt{alias jet =
	u:d:s:c:U:D:S:C:g}, respectively.
	%%%%%
	\item
	\ttt{all} \newline
	\ttt{all} is a function that works on a logical expression and a list,
	\ttt{all {\em <log\_expr>} [{\em <list>}]}, and returns \ttt{true} if and only if
	\ttt{log\_expr} is fulfilled for {\em all} entries in \ttt{list}, and
	\ttt{false} otherwise. Examples: \ttt{all Pt > 100 GeV [lepton]}
	checks whether all leptons are harder than 100 GeV, \ttt{all Dist > 2
	[u:U, d:D]} checks whether all pairs of corresponding quarks
	are separated in $R$ space by more than 2. Logical expressions with
	\ttt{all} can be logically combined with \ttt{and} and
	\ttt{or}. (cf. also \ttt{any}, \ttt{and}, \ttt{no}, and \ttt{or})
	%%%%%
	\item
	\ttt{alt\_setup} \newline
	This command allows to specify alternative setups for a process/list
	of processes, \ttt{alt\_setup = \{ {\em <setup1>} \} [, \{ {\em <setup2>} \} ,
	...]}. An alternative setup can be a resetting of a coupling
	constant, or different cuts etc. It can be particularly used in a
	($\to$) \ttt{rescan} procedure.
	%%%%%
	\item
	\ttt{analysis} \newline
	This command, \ttt{analysis = {\em <log\_expr>}}, allows to define an
	analysis as a logical expression, with a syntax similar to the ($\to$)
	\ttt{cuts} or ($\to$) \ttt{selection} command. Note that a ($\to$)
	formally is a logical expression.
	%%%%%
	\item
	\ttt{and} \newline
	This is the standard two-place logical connective that has the value
	true if both of its operands are true, otherwise a value of false. It
	is applied to logical values, e.g. cut expressions. (cf. also
	\ttt{all}, \ttt{no}, \ttt{or}).
	%%%%%
	\item
	\ttt{any} \newline
	\ttt{any} is a function that works on a logical expression and a list,
	\ttt{any {\em <log\_expr>} [{\em <list>}]}, and returns \ttt{true} if
	\ttt{log\_expr} is fulfilled for any entry in \ttt{list}, and
	\ttt{false} otherwise. Examples: \ttt{any PDG == 13 [lepton]} checks
	whether any lepton is a muon, \ttt{any E > 2 * mW [jet]} checks
	whether any jet has an energy of twice the $W$ mass. Logical
	expressions with \ttt{any} can be logically combined with \ttt{and}
	and \ttt{or}. (cf. also \ttt{all}, \ttt{and}, \ttt{no}, and \ttt{or})
	%%%%%
	\item
	\ttt{as} \newline
	cf. \ttt{compile}
	%%%%%
	\item
	\ttt{ascii} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of the standard \whizard\ verbose/debug ASCII event
	files. (cf. also \ttt{\$sample}, \ttt{\$sample\_normalization},
	\ttt{sample\_format})
	%%%%%
	\item
	\ttt{asin} \newline
	Numerical function \ttt{asin ({\em <num\_val>})} that calculates the
	arcsine trigonometric function (inverse of \ttt{sin}) of real and
	complex numerical numbers or variables. (cf. also \ttt{sin},
	\ttt{cos}, \ttt{tan}, \ttt{acos}, \ttt{atan})
	%%%%%
	\item
	\ttt{atan} \newline
	Numerical function \ttt{atan ({\em <num\_val>})} that calculates the
	arctangent trigonometric function (inverse of \ttt{tan}) of real and
	complex numerical numbers or variables. (cf. also \ttt{sin},
	\ttt{cos}, \ttt{tan}, \ttt{asin}, \ttt{acos})
	%%%%%
	\item
	\ttt{athena} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of the ATHENA variant for HEPEVT ASCII event
	files. (cf. also \ttt{\$sample}, \ttt{\$sample\_normalization},
	\ttt{sample\_format})
	%%%%%
	\item
	\ttt{beam} \newline
	Constructor that specifies a particle (in a subevent) as beam particle. It is
	used in cuts, analyses or selections, e.g. \ttt{cuts = all Theta > 20
	degree [beam lepton, lepton]}. (cf. also \ttt{incoming}, \ttt{outgoing},
	\ttt{cuts}, \ttt{analysis}, \ttt{selection}, \ttt{record})
	%%%%%
	\item
	\ttt{beam\_events} \newline
	Beam structure specifier to read in lepton collider beamstrahlung's
	spectra from external files as pairs of energy fractions: \ttt{beams:
	e1, E1 => beam\_events}. Note that this is a pair spectrum that has to
	be applied to both beams simultaneously. (cf. also \ttt{beams},
	\ttt{\$beam\_events\_file}, \ttt{?beam\_events\_warn\_eof})
	%%%%%
	\item
	\ttt{beams} \newline
	This specifies the contents and structure of the beams: \ttt{beams =
	{\em <prt1>}, {\em <prt2>} [ => {\em <str\_fun1>} ....]}. If this
	command is absent in the input file, \whizard\ automatically takes the
	two incoming partons (or one for decays) of the corresponding process
	as beam particles, and no structure functions are applied. Protons and
	antiprotons as beam particles are predefined as \ttt{p} and
	\ttt{pbar}, respectively. A structure function, like \ttt{pdf\_builtin},
	\ttt{ISR}, \ttt{EPA} and so on are switched on as e.g. \ttt{beams = p,
	p => lhapdf}. Structure functions can be specified for one of the two
	beam particles only, of the structure function is not a
	spectrum. (cf. also \ttt{beams\_momentum}, \ttt{beams\_theta},
	\ttt{beams\_phi}, \ttt{beams\_pol\_density},
	\ttt{beams\_pol\_fraction}, \ttt{beam\_events}, \ttt{circe1},
	\ttt{circe2}, \ttt{energy\_scan}, \ttt{epa}, \ttt{ewa}, \ttt{isr},
	\ttt{lhapdf}, \ttt{pdf\_builtin}).
	%%%%%
	\item
	\ttt{beams\_momentum} \newline
	Command to set the momenta (or energies) for the two beams of a
	scattering process: \ttt{beams\_momentum = {\em <mom1>}, {\em <mom2>}} to allow
	for asymmetric beam setups (e.g. HERA: \ttt{beams\_momentum = 27.5
	GeV, 920 GeV}). Two arguments must be present
	for a scattering process, but the command can be used with one
	argument to integrate and simulate a decay of a moving
	particle. (cf. also \ttt{beams}, \ttt{beams\_theta},
	\ttt{beams\_phi}, \ttt{beams\_pol\_density},
	\ttt{beams\_pol\_fraction})
	%%%%%
	\item
	\ttt{beams\_phi} \newline
	Same as ($\to$) \ttt{beams\_theta}, but to allow for a non-vanishing
	beam azimuth angle, too. (cf. also \ttt{beams}, \ttt{beams\_theta},
	\ttt{beams\_momentum}, \ttt{beams\_pol\_density},
	\ttt{beams\_pol\_fraction})
	%%%%%
	\item
	\ttt{beams\_pol\_density} \newline
	This command allows to specify the initial state for polarized beams
	by the syntax: \ttt{beams\_pol\_density = @({\em <pol\_spec\_1>}),
	@({\em <pol\_spec\_2>})}. Two polarization specifiers are mandatory for
	scattering, while one can be used for decays from polarized
	probes. The specifier \ttt{{\em <pol\_spec\_i>}} can be empty (no
	polarization), has one entry (for a definite helicity/spin
	orientation), or ranges of entries of a spin density matrix. The
	command can be used globally, or as a local argument of the
	\ttt{integrate} command. For detailed information, see
	Sec.~\ref{sec:initialpolarization}. It is also possible to use
	variables as placeholders in the specifiers. Note that polarization is
	assumed to be complete, for partial polarization use ($\to$)
	\ttt{beams\_pol\_fraction}. (cf. also \ttt{beams}, \ttt{beams\_theta},
	\ttt{beams\_phi}, \ttt{beams\_momentum}, \ttt{beams\_pol\_fraction})
	%%%%%
	\item
	\ttt{beams\_pol\_fraction} \newline
	This command allows to specify the amount of polarization when using
	polarized beams ($\to$ \ttt{beams\_pol\_density}). The syntax is:
	\ttt{beams\_pol\_fraction = {\em <frac\_1>}, {\em <frac\_2>}}. Two fractions must
	be present for scatterings, being real numbers between \ttt{0} and
	\ttt{1}. A specification with percentage is also possible,
	e.g. \ttt{beams\_pol\_fraction = 80\%, 40\%}. (cf. also \ttt{beams},
	\ttt{beams\_theta}, \ttt{beams\_phi}, \ttt{beams\_momentum},
	\ttt{beams\_pol\_density})
	%%%%%
	\item
	\ttt{beams\_theta} \newline
	Command to set a crossing angle (with respect to the $z$ axis) for one
	or both of the beams of a
	scattering process: \ttt{beams\_theta = {\em <angle1>}, {\em <angle2>}} to allow
	for asymmetric beam setups (e.g. \ttt{beams\_angle = 0, 10
	degree}). Two arguments must be present for a scattering process, but
	the command can be used with one argument to integrate and simulate a
	decay of a moving particle. (cf. also \ttt{beams}, \ttt{beams\_phi},
	\ttt{beams\_momentum}, \ttt{beams\_pol\_density},
	\ttt{beams\_pol\_fraction})
	%%%%%
	\item
	\ttt{by} \newline
	Constructor that replaces the default sorting criterion (according to
	PDG codes) of the ($\to$) \ttt{sort} function on particle
	lists/subevents by one given by a unary or binary particle observable:
	\ttt{sort by {\em <observable>} [{\em <particles>} [, {\em
	<ref\_particles>}] ]}. (cf. also \ttt{sort}, \ttt{extract}, \ttt{join},
	\ttt{collect}, \ttt{combine}, \ttt{+})
	%%%%%
	\item
	\ttt{ceiling} \newline
	This is a function \ttt{ceiling ({\em <num\_val>})} that gives the
	least integer greater than or equal to \ttt{{\em <num\_val>}},
	e.g. \ttt{int i = ceiling (4.56789)} gives \ttt{i = 5}. (cf. also
	\ttt{int}, \ttt{nint}, \ttt{floor})
	%%%%%
	\item
	\ttt{circe1} \newline
	Beam structure specifier for the \circeone\ structure function for
	beamstrahlung at a linear lepton collider: \ttt{beams = e1, E1 =>
	circe1}. Note that this is a pair spectrum, so the specifier acts for
	both beams simultaneously. (cf. also \ttt{beams}, \ttt{?circe1\_photons},
	\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts},
	\ttt{?circe1\_generate}, \ttt{?circe1\_map},
	\ttt{circe1\_eps}, \newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver},
	\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat})
	%%%%%
	\item
	\ttt{circe2} \newline
	Beam structure specifier for the lepton-collider structure function
	for photon spectra, \circetwo: \ttt{beams = A, A => circe2}. Note that
	this is a pair spectrum, an application to only one beam is not
	possible. (cf. also \ttt{beams}, \ttt{?circe2\_polarized},
	\ttt{\$circe2\_file}, \ttt{\$circe2\_design})
	%%%%%
	\item
	\ttt{clear} \newline
	This command allows to clear a variable set before: \ttt{clear
	({\em <clearable var.>})} resets the variable \ttt{{\em <clearable var.>}} which
	could be the \ttt{beams}, the \ttt{unstable} settings, \ttt{sqrts},
	any kind of \ttt{cuts} or \ttt{scale} expressions, any user-set
	variable etc. The syntax of the command is completely analogous to
	($\to$) \ttt{show}.
	%%%%%
	\item
	\ttt{close\_out} \newline
	With the command, \ttt{close\_out ("{\em <out\_file">})} user-defined
	information like data or ($\to$) \ttt{printf} statements can be
	written out to a user-defined file. The command closes an I/O stream to
	an external file \ttt{{\em <out\_file>}}. (cf. also \ttt{open\_out},
	\ttt{\$out\_file}, \ttt{printf})
	%%%%%
	\item
	\ttt{cluster} \newline
	Command that allows to cluster all particles in a subevent to a set of
	jets: \ttt{cluster [{\em<particles>}]}. It also to cluster particles
	subject to a certain boolean condition, \ttt{cluster if
	{\em<condition>} [{\em<particles>}]}. At the moment only available
	if the \fastjet\ package is linked.
	(cf. also \ttt{jet\_r}, \ttt{combine}, \ttt{jet\_algorithm},
	\ttt{kt\_algorithm}, \newline \ttt{cambridge\_[for\_passive\_]algorithm},
	\ttt{antikt\_algorithm}, \ttt{plugin\_algorithm}, \newline
	\ttt{genkt\_[for\_passive\_]algorithm},
	\ttt{ee\_kt\_algorithm}, \ttt{ee\_genkt\_algorithm},
	\ttt{?keep\_flavors\_when\_clustering})
	%%%%%
	\item
	\ttt{collect} \newline
	The \ttt{collect [{\em <list>}]} operation collects all particles in
	the list \ttt{{\em <list>}} into a one-entry subevent with a
	four-momentum of the sum of all four-momenta of non-overlapping
	particles in \ttt{{\em <list>}}. (cf. also \ttt{combine},
	\ttt{select}, \ttt{extract}, \ttt{sort})
	%%%%%
	\item
	\ttt{complex} \newline
	Defines a complex variable. The syntax is e.g. \ttt{complex x = 2 + 3
	* I}. (cf.~also \ttt{int}, \ttt{real})
	%%%%%
	\item
	\ttt{combine} \newline
	The \ttt{combine [{\em <list1>}, {\em <list2>}]} operation makes a particle list
	whose entries are the result of adding (the momenta of) each pair of
	particles in the two input lists \ttt{list1}, {list2}. For example,
	\ttt{combine [incoming lepton, lepton]} constructs all mutual pairings
	of an incoming lepton with an outgoing lepton (an alias for the
	leptons has to be defined, of course). (cf. also \ttt{collect},
	\ttt{select}, \ttt{extract}, \ttt{sort}, \ttt{+})
	%%%%%
	\item
	\ttt{compile} \newline
	The \ttt{compile ()} command has no arguments (the parentheses can
	also been left out: /\ttt{compile ()}. The command is optional, it
	invokes the compilation of the process(es) (i.e. the matrix element
	file(s)) to be compiled as a shared library. This shared object file
	has the standard name \ttt{default\_lib.so} and resides in the
	\ttt{.libs} subdirectory of the corresponding user workspace. If the
	user has defined a different library name \ttt{lib\_name} with the
	\ttt{library} command, then WHIZARD compiles this as the shared object
	\ttt{.libs/lib\_name.so}. (This allows to split process classes and to
	avoid too large libraries.)
	Another possibility is to use the command \ttt{compile as
	"static\_name"}. This will compile and link the process library in a
	static way and create the static executable \ttt{static\_name} in the
	user workspace. (cf. also \ttt{library})
	%%%%%
	\item
	\ttt{compile\_analysis} \newline
	The \ttt{compile\_analysis} statement does the same as
	the \ttt{write\_analysis} command, namely to tell \whizard\ to write
	the analysis setup by the user for the \sindarin\ input file under
	consideration. If no \ttt{\$out\_file} is provided, the histogram
	tables/plot data etc. are written to the default file
	\ttt{whizard\_analysis.dat}. In addition to \ttt{write\_analysis},
	\ttt{compile\_analysis} also invokes the \whizard\ \LaTeX routines for
	producing postscript or PDF output of the data (unless the flag
	$\rightarrow$ \ttt{?analysis\_file\_only} is set to \ttt{true}).
	(cf. also \ttt{\$out\_file}, \ttt{write\_analysis},
	\ttt{?analysis\_file\_only})
	%%%%%
	\item
	\ttt{conjg} \newline
	Numerical function that takes the complex conjugate of its argument:
	\ttt{conjg ({\em <num\_val>})} yields \ttt{{\em
	<num\_val>}$^\ast$}. (cf. also \ttt{abs}, \ttt{sgn}, \ttt{mod}, \ttt{modulo})
	%%%%%
	\item
	\ttt{cos} \newline
	Numerical function \ttt{cos ({\em <num\_val>})} that calculates the
	cosine trigonometric function of real and complex numerical numbers or
	variables. (cf. also \ttt{sin}, \ttt{tan}, \ttt{asin}, \ttt{acos},
	\ttt{atan})
	%%%%%
	\item
	\ttt{cosh} \newline
	Numerical function \ttt{cosh ({\em <num\_val>})} that calculates the
	hyperbolic cosine function of real and complex numerical numbers or
	variables. Note that its inverse function is part of the
	\ttt{Fortran2008} status and hence not realized. (cf. also \ttt{sinh},
	\ttt{tanh})
	%%%%%
	\item
	\ttt{count} \newline
	Subevent function that counts the number of particles or particle
	pairs in a subevent: \ttt{count [{\em <particles\_1>} [, {\em
	<particles\_2>}]]}. This can also be a counting subject to a
	condition: \ttt{count if {\em <condition>} [{\em <particles\_1>} [,
	{\em <particles\_2>}]]}.
	%%%%%
	\item
	\ttt{cuts} \newline
	This command defines the cuts to be applied to certain processes. The
	syntax is: \ttt{cuts = {\em <log\_class>} {\em <log\_expr>} [{\em <unary or binary
	particle (list) arg>}]}, where the cut expression must be initialized
	with a logical classifier \ttt{log\_class} like \ttt{all}, \ttt{any},
	\ttt{no}. The logical expression \ttt{log\_expr} contains the cut to
	be evaluated. Note that this need not only be a kinematical cut
	expression like \ttt{E > 10 GeV} or \ttt{5 degree < Theta < 175 degree},
	but can also be some sort of trigger expression or event selection.
	Whether the expression is evaluated on particles or pairs
	of particles depends on whether the discriminating variable is unary or
	binary, \ttt{Dist} being obviously binary, \ttt{Pt} being unary. Note that
	some variables are both unary and binary, e.g. the invariant mass $M$. Cut
	expressions can be connected by the logical connectives \ttt{and} and
	\ttt{or}. The \ttt{cuts} statement acts on all subsequent process
	integrations and analyses until a new \ttt{cuts} statement appears.
	(cf. also \ttt{all}, \ttt{any},
	\ttt{Dist}, \ttt{E}, \ttt{M},
	\ttt{no}, \ttt{Pt}).
	%%%%%
	\item
	\ttt{debug} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of the very verbose \whizard\ ASCII event
	file format intended for debugging. (cf. also \ttt{\$sample},
	\ttt{sample\_format}, \ttt{\$sample\_normalization})
	%%%%%
	\item
	\ttt{degree} \newline
	Expression specifying the physical unit of degree for angular
	variables, e.g. the cut expression function \ttt{Theta}. (if no unit is
	specified for angular variables, radians are used; cf. \ttt{rad}, \ttt{mrad}).
	%%%%
	\item
	\ttt{Dist} \newline
	Binary observable specifier, that gives the $\eta$-$\phi$-
	(pseudorapidity-azimuth) distance $R = \sqrt{(\Delta \eta)^2 +
	(\Delta\phi)^2}$ between the momenta of the two particles: \ttt{eval
	Dist [jet, jet]}. (cf. also \ttt{eval}, \ttt{cuts}, \ttt{selection},
	\ttt{Theta}, \ttt{Eta}, \ttt{Phi})
	%%%%%
	\item
	\ttt{dump} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of the intrinsic \whizard\ event record format
	(output of the \ttt{particle\_t} type container). (cf. also
	\ttt{\$sample}, \ttt{sample\_format}, \ttt{\$sample\_normalization}
	%%%%%
	\item
	\ttt{E} \newline
	Unary (binary) observable specifier for the energy of a single
	(two) particle(s), e.g. \ttt{eval E ["W+"]}, \ttt{all E > 200 GeV [b,
	B]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
	%%%%%
	\item
	\ttt{else} \label{sindarin_else}\newline
	Constructor for providing an alternative in a conditional clause:
	\ttt{if {\em <log\_expr>} then {\em <expr 1>} else {\em <expr 2>} endif}. (cf. also
	\ttt{if}, \ttt{elsif}, \ttt{endif}, \ttt{then}).
	%%%%%
	\item
	\ttt{elsif} \newline
	Constructor for concatenating more than one conditional clause with
	each other: \ttt{if {\em <log\_expr 1>} then {\em <expr 1>} elsif {\em <log\_expr 2>}
	then {\em <expr 2>} \ldots endif}. (cf. also \ttt{if}, \ttt{else},
	\ttt{endif}, \ttt{then}).
	%%%%%
	\item
	\ttt{endif} \newline
	Mandatory constructor to conclude a conditional clause: \ttt{if
	{\em <log\_expr>} then \ldots endif}. (cf. also \ttt{if},
	\ttt{else}, \ttt{elsif}, \ttt{then}).
	%%%%%
	\item
	\ttt{energy\_scan} \newline
	Beam structure specifier for the energy scan structure function:
	\ttt{beams = e1, E1 => energy\_scan}. This pair spectrum that has to
	be applied to both beams simultaneously can be used to scan over a
	range of collider energies without using the \ttt{scan} command.
	(cf. also \ttt{beams}, \ttt{scan}, \ttt{?energy\_scan\_normalize})
	%%%%%
	\item
	\ttt{epa} \newline
	Beam structure specifier for the equivalent-photon approximation
	(EPA), i.e the Weizs\"acker-Williams structure function:
	e.g. \ttt{beams = e1, E1 => epa} (applied to both beams), or
	e.g. \ttt{beams = e1, u => epa, none} (applied to only one
	beam). (cf. also \ttt{beams}, \ttt{epa\_alpha}, \ttt{epa\_x\_min},
	\ttt{epa\_mass}, \ttt{epa\_q\_max}, \ttt{epa\_q\_min},
	\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})
	%%%%%
	\item
	\ttt{Eta} \newline
	Unary and also binary observable specifier, that as a unary observable
	gives the pseudorapidity of a particle momentum. The pseudorapidity is
	given by $\eta = - \log \left[ \tan (\theta/2) \right]$, where
	$\theta$ is the angle with the beam direction. As a binary
	observable, it gives the pseudorapidity difference between the momenta
	of two particles, where $\theta$ is the enclosed angle: \ttt{eval Eta
	[e1]}, \ttt{all abs (Eta) < 3.5 [jet, jet]}. (cf. also \ttt{eval},
	\ttt{cuts}, \ttt{selection}, \ttt{Rap}, \ttt{abs})
	%%%%%
	\item
	\ttt{eV} \newline
	Physical unit, stating that the corresponding number is in electron
	volt. (cf. also \ttt{keV}, \ttt{meV}, \ttt{MeV}, \ttt{GeV}, \ttt{TeV})
	%%%%%
	\item
	\ttt{eval} \newline
	Evaluator that tells \whizard\ to evaluate the following expr:
	\ttt{eval {\em <expr>}}. Examples are: \ttt{eval Rap [e1]}, \ttt{eval
	M / 1 GeV [combine [q,Q]]} etc. (cf. also \ttt{cuts},
	\ttt{selection}, \ttt{record}, \ttt{sum}, \ttt{prod})
	%%%%%
	\item
	\ttt{ewa} \newline
	Beam structure specifier for the equivalent-photon approximation
	(EWA): e.g. \ttt{beams = e1, E1 => ewa} (applied to both beams), or
	e.g. \ttt{beams = e1, u => ewa, none} (applied to only one
	beam). (cf. also \ttt{beams}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max},
	\ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy},
	\ttt{?ewa\_recoil})
	%%%%%
	\item
	\ttt{exec} \newline
	Constructor \ttt{exec ("{\em <cmd\_name>}")} that demands WHIZARD to
	execute/run the command \ttt{cmd\_name}. For this to work that
	specific command must be present either in the path of the operating
	system or as a command in the user workspace.
	%%%%%
	\item
	\ttt{exit} \newline
	Command to finish the \whizard\ run (and not execute any further code
	beyond the appearance of \ttt{exit} in the \sindarin\ file. The command
	(which is the same as $\to$ \ttt{quit}) allows for an argument,
	\ttt{exit ({\em <expr>})}, where the expression can be executed, e.g. a
	screen message or an exit code.
	%%%%%
	\item
	\ttt{exp} \newline
	Numerical function \ttt{exp ({\em <num\_val>})} that calculates the
	exponential of real and complex numerical numbers or
	variables. (cf. also \ttt{sqrt}, \ttt{log}, \ttt{log10})
	%%%%%
	\item
	\ttt{expect} \newline
	The binary function \ttt{expect} compares two numerical expressions
	whether they fulfill a certain ordering condition or are equal up
	to a specific uncertainty or tolerance which can bet set by the
	specifier \ttt{tolerance}, i.e. in principle it checks whether a
	logical expression is true. The \ttt{expect} function does actually
	not just check a value for correctness, but also records its result.
	If failures are present when the program terminates, the exit code is
	nonzero. The syntax is \ttt{expect ({\em <num1>} {\em
	<log\_comp>} {\em <num2>})}, where \ttt{{\em <num1>}} and
	\ttt{{\em <num2>}} are two numerical values (or
	corresponding variables) and \ttt{{\em <log\_comp>}} is one of the following
	logical comparators: \ttt{<}, \ttt{>}, \ttt{<=}, \ttt{>=}, \ttt{==},
	\ttt{<>}.
	(cf. also \ttt{<}, \ttt{>}, \ttt{<=}, \ttt{>=}, \ttt{==}, \ttt{<>},
	\ttt{tolerance}).
	%%%%%
	\item
	\ttt{extract} \newline
	Subevent function that either extracts the first element of a
	particle list/subevent: \ttt{extract [ {\em <particles>}]}, or the
	element at position \ttt{<index\_value>} of the particle list:
	\ttt{extract {\em index <index\_value>} [ {\em
	<particles>}]}. Negative index values count from the end of the
	list. (cf. also \ttt{sort}, \ttt{combine},
	\ttt{collect}, \ttt{+}, \ttt{index})
	%%%%%
	\item
	\ttt{factorization\_scale} \newline
	This is a command, \ttt{factorization\_scale = {\em <expr>}}, that sets
	the factorization scale of a process or list of processes. It
	overwrites a possible scale set by the ($\to$) \ttt{scale} command.
	\ttt{{\em <expr>}} can be any kinematic expression that leads to a result of
	momentum dimension one, e.g. \ttt{100 GeV}, \ttt{eval
	Pt [e1]}. (cf. also \ttt{renormalization\_scale}).
	%%%%%
	\item
	\ttt{false} \newline
	Constructor stating that a logical expression or variable is false,
	e.g. \ttt{?{\em <log\_var>} = false}. (cf. also \ttt{true}).
	%%%%%
	\item
	\ttt{fbarn} \newline
	Physical unit, stating that a number is in femtobarns ($10^{-15}$
	barn). (cf. also \ttt{nbarn}, \ttt{abarn}, \ttt{pbarn})
	%%%%%
	\item
	\ttt{floor} \newline
	This is a function \ttt{floor ({\em <num\_val>})} that gives the
	greatest integer less than or equal to \ttt{{\em <num\_val>}},
	e.g. \ttt{int i = floor (4.56789)} gives \ttt{i = 4}. (cf. also
	\ttt{int}, \ttt{nint}, \ttt{ceiling})
	%%%%%
	\item
	\ttt{gaussian} \newline
	Beam structure specifier that imposes a Gaussian energy distribution,
	separately for each beam. The $\sigma$ values are set by
	\ttt{gaussian\_spread1} and \ttt{gaussian\_spread2}, respectively.
	%%%%%
	\item
	\ttt{GeV} \newline
	Physical unit, energies in $10^9$ electron volt. This is the default
	energy unit of WHIZARD. (cf. also \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{meV},
	\ttt{TeV})
	%%%%%
	\item
	\ttt{graph} \newline
	This command defines the necessary information regarding producing
	a graph of a function in \whizard's internal graphical \gamelan\
	output. The syntax is: \ttt{graph {\em <record\_name>} \{ {\em <optional
	arguments>} \}}. The record with name \ttt{{\em <record\_name>}} has to be
	defined, either before or after the graph definition. Possible optional
	arguments of the \ttt{graph} command are the minimal and maximal values
	of the axes (\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}).
	(cf. \ttt{plot}, \ttt{histogram}, \ttt{record})
	%%%%%
	\item
	\ttt{Hel} \newline
	Unary observable specifier that allows to specify the helicity of a
	particle, e.g. \ttt{all Hel == -1 [e1]} in a selection. (cf. also
	\ttt{eval}, \ttt{cuts}, \ttt{selection})
	%%%%%
	\item
	\ttt{hepevt} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of HEPEVT ASCII event files. (cf. also \ttt{\$sample},
	\ttt{sample\_format})
	%%%%%
	\item
	\ttt{hepevt\_verb} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of the extended or verbose version of HEPEVT ASCII event
	files. (cf. also \ttt{\$sample}, \ttt{sample\_format})
	%%%%%
	\item
	\ttt{hepmc} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of HepMC ASCII event files. Note that this is only
	available if the HepMC package is installed and correctly
	linked. (cf. also \ttt{\$sample}, \ttt{sample\_format},
	\ttt{?hepmc\_output\_cross\_section})
	%%%%%
	\item
	\ttt{histogram} \newline
	This command defines the necessary information regarding plotting data
	as a histogram, in the form of: \ttt{histogram {\em <record\_name>} \{
	{\em <optional arguments>} \}}. The record with name \ttt{{\em <record\_name>}} has to be
	defined, either before or after the histogram definition. Possible optional
	arguments of the \ttt{histogram} command are the minimal and maximal values
	of the axes (\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}).
	(cf. \ttt{graph}, \ttt{plot}, \ttt{record})
	%%%%%
	\item
	\ttt{Ht} \newline
	Subeventary observable specifier for the transverse mass
	($\sqrt{p_T^2 + m^2}$ in the c.m. frame) summed over all particles in
	the subevent given as argument, e.g. \ttt{eval Ht [t:T:Z]}. (cf.
	\ttt{eval}, \ttt{sum}, \ttt{prod}, \ttt{Pt}, \ttt{M})
	%%%%%
	\item
	\ttt{if} \newline
	Conditional clause with the construction \ttt{if {\em <log\_expr>} then
	{\em <expr>} [else {\em <expr>} \ldots] endif}. Note that there must be an
	\ttt{endif} statement. For more complicated expressions it is better
	to use expressions in parentheses: \ttt{if ({\em <log\_expr>}) then
	\{{\em <expr>}\} else \{{\em <expr>}\} endif}. Examples are a selection of up quarks
	over down quarks depending on a logical variable: \ttt{if ?ok then u
	else d}, or the setting of an integer variable depending on the
	rapidity of some particle: \ttt{if (eta > 0) then \{ a = +1\} else
	\{ a = -1\}}. (cf. also \ttt{elsif}, \ttt{endif}, \ttt{then})
	%%%%%
	\item
	\ttt{in} \newline
	Second part of the constructor to let a variable be local to an
	expression. It has the syntax \ttt{let {\em <var>} = {\em <value>} in
	{\em <expression>}}. E.g. \ttt{let int a = 3 in let int b = 4 in
	{\em <expression>}} (cf. also \ttt{let})
	%%%%%
	\item
	\ttt{include} \newline
	The \ttt{include} statement, \ttt{include ("file.sin")} allows to
	include external \sindarin\ files \ttt{file.sin} into the main WHIZARD
	input file. A standard example is the inclusion of the standard cut
	file \ttt{default\_cuts.sin}.
	%%%%%
	\item
	\ttt{incoming} \newline
	Constructor that specifies particles (or subevents) as incoming. It is
	used in cuts, analyses or selections, e.g. \ttt{cuts = all Theta > 20
	degree [incoming lepton, lepton]}. (cf. also \ttt{beam}, \ttt{outgoing},
	\ttt{cuts}, \ttt{analysis}, \ttt{selection}, \ttt{record})
	%%%%%
	\item
	\ttt{index} \newline
	Specifies the position of the element of a particle to be extracted by
	the subevent function ($\to$) \ttt{extract}: \ttt{extract {\em index
	<index\_value>} [ {\em <particles>}]}. Negative index values count
	from the end of the list. (cf. also \ttt{extract}, \ttt{sort}, \ttt{combine},
	\ttt{collect}, \ttt{+})
	%%%%%
	\item
	\ttt{int} \newline
	1) This is a constructor to specify integer constants in the input
	file. Strictly speaking, it is a unary function setting the value
	\ttt{int\_val} of the integer variable \ttt{int\_var}:
	\ttt{int {\em <int\_var>} = {\em <int\_val>}}. Note that is mandatory for all
	user-defined variables. (cf. also \ttt{real} and \ttt{complex})
	2) It is a function \ttt{int ({\em <num\_val>})} that converts real and
	complex numbers (here their real parts) into integers. (cf. also
	\ttt{nint}, \ttt{floor}, \ttt{ceiling})
	%%%%%
	\item
	\ttt{integrate} \newline
	The \ttt{integrate ({\em <proc\_name>}) \{ {\em <integrate\_options>} \}} command
	invokes the integration (phase-space generation and Monte-Carlo
	sampling) of the process \ttt{proc\_name} (which can also be a list of
	processes) with the integration options
	\ttt{{\em <integrate\_options>}}. Possible options are (1) via
	\ttt{\$integration\_method = "{\em <intg. method>}"} the integration
	method (the default being VAMP), (2) the number of iterations and
	calls per integration during the Monte-Carlo phase-space integration
	via the \ttt{iterations} specifier; (3) goal for the
	accuracy, error or relative error (\ttt{accuracy\_goal},
	\ttt{error\_goal}, \ttt{relative\_error\_goal}). (4) Invoking only
	phase space generation (\ttt{?phs\_only = true}), (5) making test
	calls of the matrix element. (cf. also \ttt{iterations},
	\ttt{accuracy\_goal}, \ttt{error\_goal}, \ttt{relative\_error\_goal},
	\ttt{error\_threshold})
	%%%%%
	\item
	\ttt{isr} \newline
	Beam structure specifier for the lepton-collider/QED initial-state
	radiation (ISR) structure function: e.g. \ttt{beams = e1, E1 => isr}
	(applied to both beams), or e.g. \ttt{beams = e1, u => isr, none}
	(applied to only one beam). (cf. also \ttt{beams}, \ttt{isr\_alpha},
	\ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order},
	\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})
	%%%%%
	\item
	\ttt{iterations} \qquad (default: internal heuristics) \newline
	Option to set the number of iterations and calls per iteration during
	the Monte-Carlo phase-space integration process. The syntax is
	\ttt{iterations = {\em <n\_iterations>}:{\em <n\_calls>}}. Note that this can be
	also a list, separated by colons, which breaks up the integration
	process into passes of the specified number of integrations and calls
	each. It works for all integration methods. For VAMP, there is the
	additional option to specify whether grids and channel weights should
	be adapted during iterations (\ttt{"g"}, \ttt{"w"},
	\ttt{"gw"} for both, or \ttt{""} for no adaptation). (cf. also
	\ttt{integrate}, \ttt{accuracy\_goal}, \ttt{error\_goal},
	\ttt{relative\_error\_goal}, \ttt{error\_threshold}).
	%%%%%
	\item
	\ttt{join} \newline
	Subevent function that concatenates two particle lists/subevents if
	there is no overlap: \ttt{join [{\em <particles>}, {\em
	<new\_particles>}]}. The joining of the two lists can also be made
	depending on a condition: \ttt{join if {\em <condition>} [{\em
	<particles>}, {\em <new\_particles>}]}. (cf. also \ttt{\&},
	\ttt{collect}, \ttt{combine}, \ttt{extract}, \ttt{sort}, \ttt{+})
	%%%%%
	\item
	\ttt{keV} \newline
	Physical unit, energies in $10^3$ electron volt. (cf. also \ttt{eV},
	\ttt{meV}, \ttt{MeV}, \ttt{GeV}, \ttt{TeV})
	%%%%%
	\item
	\ttt{kT} \newline
	Binary particle observable that represents a jet $k_T$ clustering
	measure: \ttt{kT [j1, j2]} gives the following kinematic expression:
	$2 \min(E_{j1}^2, E_{j2}^2) / Q^2 \times (1 - \cos\theta_{j1,j2})$. At the
	moment, $Q^2 = 1$.
	%%%%%
	\item
	\ttt{let} \newline
	This allows to let a variable be local to an expression. It has the
	syntax \ttt{let {\em <var>} = {\em <value>} in {\em <expression>}}.
	E.g. \ttt{let int a = 3 in let int b = 4 in {\em <expression>}}
	(cf. also \ttt{in})
	%%%%%
	\item
	\ttt{lha} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of the \whizard\ version 1 style (deprecated) LHA ASCII event
	format files. (cf. also \ttt{\$sample}, \newline
	\ttt{sample\_format})
	%%%%%
	\item
	\ttt{lhapdf} \newline
	This is a beams specifier to demand calling \lhapdf\ parton densities as
	structure functions to integrate processes in hadron collisions. Note
	that this only works if the external \lhapdf\ library is present and
	correctly linked. (cf. \ttt{beams}, \ttt{\$lhapdf\_dir},
	\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon},
	\ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member},
	\ttt{lhapdf\_photon\_scheme})
	%%%%%
	\item
	\ttt{lhapdf\_photon} \newline
	This is a beams specifier to demand calling \lhapdf\ parton densities as
	structure functions to integrate processes in hadron collisions with a
	photon as initializer of the hard scattering process. Note
	that this only works if the external \lhapdf\ library is present and
	correctly linked. (cf. \ttt{beams}, \ttt{lhapdf}, \ttt{\$lhapdf\_dir},
	\ttt{\$lhapdf\_file}, \ttt{\$lhapdf\_photon\_file},
	\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})
	%%%%%
	\item
	\ttt{lhef} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of the Les Houches Accord (LHEF) event format files, with
	XML headers. There are several different versions of this format,
	which can be selected via the \ttt{\$lhef\_version} specifier
	(cf. also \ttt{\$sample}, \ttt{sample\_format}, \ttt{\$lhef\_version},
	\ttt{\$lhef\_extension}, \ttt{?lhef\_write\_sqme\_prc},
	\newline \ttt{?lhef\_write\_sqme\_ref}, \ttt{?lhef\_write\_sqme\_alt})
	%%%%%
	\item
	\ttt{library} \newline
	The command \ttt{library = "{\em <lib\_name>}"} allows to specify a separate
	shared object library archive \ttt{lib\_name.so}, not using the
	standard library \ttt{default\_lib.so}. Those libraries (when using
	shared libraries) are located in the \ttt{.libs} subdirectory of the
	user workspace. Specifying a separate library is useful for splitting
	up large lists of processes, or to restrict a larger number of
	different loaded model files to one specific process library.
	(cf. also \ttt{compile}, \ttt{\$library\_name})
	%%%%%
	\item
	\ttt{log} \newline
	Numerical function \ttt{log ({\em <num\_val>})} that calculates the
	natural logarithm of real and complex numerical numbers or
	variables. (cf. also \ttt{sqrt}, \ttt{exp}, \ttt{log10})
	%%%%%
	\item
	\ttt{log10} \newline
	Numerical function \ttt{log10 ({\em <num\_val>})} that calculates the
	base 10 logarithm of real and complex numerical numbers or
	variables. (cf. also \ttt{sqrt}, \ttt{exp}, \ttt{log})
	%%%%%
	\item
	\ttt{long} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of the long variant of HEPEVT ASCII event
	files. (cf. also \ttt{\$sample},
	\ttt{sample\_format})
	%%%%%
	\item
	\ttt{M} \newline
	Unary (binary) observable specifier for the (signed) mass of a single
	(two) particle(s), e.g. \ttt{eval M [e1]}, \ttt{any M = 91 GeV [e2,
	E2]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
	%%%%%
	\item
	\ttt{M2} \newline
	Unary (binary) observable specifier for the mass squared of a single
	(two) particle(s), e.g. \ttt{eval M2 [e1]}, \ttt{all M2 > 2*mZ [e2,
	E2]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
	%%%%%
	\item
	\ttt{max} \newline
	Numerical function with two arguments \ttt{max ({\em <var1>}, {\em
	<var2>})} that gives the maximum of the two arguments: $\max (var1,
	var2)$. It can act on all combinations of integer and real
	variables. Example: \ttt{real heavier\_mass = max (mZ, mH)}. (cf. also
	\ttt{min})
	%%%%%
	\item
	\ttt{meV} \newline
	Physical unit, stating that the corresponding number is in $10^{-3}$
	electron volt. (cf. also \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{GeV},
	\ttt{TeV})
	%%%%%
	\item
	\ttt{MeV} \newline
	Physical unit, energies in $10^6$ electron volt. (cf. also \ttt{eV},
	\ttt{keV}, \ttt{meV}, \ttt{GeV}, \ttt{TeV})
	%%%%%
	\item
	\ttt{min} \newline
	Numerical function with two arguments \ttt{min ({\em <var1>}, {\em
	<var2>})} that gives the minimum of the two arguments: $\min (var1,
	var2)$. It can act on all combinations of integer and real
	variables. Example: \ttt{real lighter\_mass = min (mZ, mH)}. (cf. also
	\ttt{max})
	%%%%%
	\item
	\ttt{mod} \newline
	Numerical function for integer and real numbers \ttt{mod (x, y)} that
	computes the remainder of the division of \ttt{x} by \ttt{y} (which
	must not be zero). (cf. also
	\ttt{abs}, \ttt{conjg}, \ttt{sgn}, \ttt{modulo})
	%%%%%
	\item
	\ttt{model} \qquad (default: \ttt{SM}) \newline
	With this specifier, \ttt{model = {\em <model\_name>}}, one sets the hard
	interaction physics model for the processes defined after this model
	specification. The list of available models can be found in Table
	\ref{tab:models}. Note that the model specification can appear
	arbitrarily often in a \sindarin\ input file, e.g. for compiling and
	running processes defined in different physics models. (cf. also
	\ttt{\$model\_name})
	%%%%%
	\item
	\ttt{modulo} \newline
	Numerical function for integer and real numbers \ttt{modulo (x, y)} that
	computes the value of $x$ modulo $y$. (cf. also
	\ttt{abs}, \ttt{conjg}, \ttt{sgn}, \ttt{mod})
	%%%%%
	\item
	\ttt{mokka} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of the MOKKA variant for HEPEVT ASCII event
	files. (cf. also \ttt{\$sample},
	\ttt{sample\_format})
	%%%%%
	\item
	\ttt{mrad} \newline
	Expression specifying the physical unit of milliradians for angular
	variables. This default in \whizard\ is \ttt{rad}. (cf. \ttt{degree}, \ttt{rad}).
	%%%%%
	\item
	\ttt{nbarn} \newline
	Physical unit, stating that a number is in nanobarns ($10^{-9}$
	barn). (cf. also \ttt{abarn}, \ttt{fbarn}, \ttt{pbarn})
	%%%%%
	\item
	\ttt{n\_in} \newline
	Integer variable that accesses the number of incoming particles of a
	process. It can be used in cuts or in an analysis. (cf. also
	\ttt{sqrts\_hat}, \ttt{cuts}, \ttt{record}, \ttt{n\_out}, \ttt{n\_tot})
	%%%%%
	\item
	\ttt{Nacl} \newline
	Unary observable specifier that returns the total number of open anticolor lines
	of a particle or subevent (i.e., composite particle). Defined only if
	\ttt{?colorize\_subevt} is true.. (cf. also
	\ttt{Ncol}, \ttt{?colorize\_subevt})
	%%%%%
	\item
	\ttt{Ncol} \newline
	Unary observable specifier that returns the total number of open color lines
	of a particle or subevent (i.e., composite particle). Defined only if
	\ttt{?colorize\_subevt} is true.. (cf. also
	\ttt{Nacl}, \ttt{?colorize\_subevt})
	%%%%%
	\item
	\ttt{nint} \newline
	This is a function \ttt{nint ({\em <num\_val>})} that converts real
	numbers into the closest integer, e.g. \ttt{int i = nint (4.56789)}
	gives \ttt{i = 5}. (cf. also
	\ttt{int}, \ttt{floor}, \ttt{ceiling})
	%%%%%
	\item
	\ttt{no} \newline
	\ttt{no} is a function that works on a logical expression and a list,
	\ttt{no {\em <log\_expr>} [{\em <list>}]}, and returns \ttt{true} if and only if
	\ttt{log\_expr} is fulfilled for {\em none} of the entries in
	\ttt{list}, and \ttt{false} otherwise. Examples: \ttt{no Pt < 100 GeV
	[lepton]} checks whether no lepton is softer than 100 GeV. It is the
	logical opposite of the function \ttt{all}. Logical expressions with
	\ttt{no} can be logically combined with \ttt{and} and
	\ttt{or}. (cf. also \ttt{all}, \ttt{any}, \ttt{and}, and \ttt{or})
	%%%%%
	\item
	\ttt{none} \newline
	Beams specifier that can used to explicitly {\em not} apply a
	structure function to a beam, e.g. in HERA physics: \ttt{beams = e1, P
	=> none, pdf\_builtin}. (cf. also \ttt{beams})
	%%%%%
	\item
	\ttt{not} \newline
	This is the standard logical negation that converts true into false
	and vice versa. It is applied to logical values, e.g. cut
	expressions. (cf. also \ttt{and}, \ttt{or}).
	%%%%%
	\item
	\ttt{n\_out} \newline
	Integer variable that accesses the number of outgoing particles of a
	process. It can be used in cuts or in an analysis. (cf. also
	\ttt{sqrts\_hat}, \ttt{cuts}, \ttt{record}, \ttt{n\_in}, \ttt{n\_tot})
	%%%%%
	\item
	\ttt{n\_tot} \newline
	Integer variable that accesses the total number of particles (incoming
	plus outgoing) of a process. It can be used in cuts or in an
	analysis. (cf. also \ttt{sqrts\_hat}, \ttt{cuts}, \ttt{record},
	\ttt{n\_in}, \ttt{n\_out})
	%%%%%
	\item
	\ttt{observable} \newline
	With this, \ttt{observable = {\em <obs\_spec>}}, the user is able to define
	a variable specifier \ttt{obs\_spec} for observables. These can be
	reused in the analysis, e.g. as a \ttt{record}, as functions of the
	fundamental kinematical variables of the processes.
	(cf. \ttt{analysis}, \ttt{record})
	%%%%%
	\item
	\ttt{open\_out} \newline
	With the command, \ttt{open\_out ("{\em <out\_file">})} user-defined
	information like data or ($\to$) \ttt{printf} statements can be
	written out to a user-defined file. The command opens an I/O stream to
	an external file \ttt{{\em <out\_file>}}. (cf. also \ttt{close\_out},
	\ttt{\$out\_file}, \ttt{printf})
	%%%%%
	\item
	\ttt{or} \newline
	This is the standard two-place logical connective that has the value
	true if one of its operands is true, otherwise a value of false. It
	is applied to logical values, e.g. cut expressions. (cf. also
	\ttt{and}, \ttt{not}).
	%%%%%
	\item
	\ttt{outgoing} \newline
	Constructor that specifies particles (or subevents) as outgoing. It is
	used in cuts, analyses or selections, e.g. \ttt{cuts = all Theta > 20
	degree [incoming lepton, outgoing lepton]}. Note that the \ttt{outgoing}
	keyword is redundant and included only for completeness: \ttt{outgoing lepton}
	has the same meaning as \ttt{lepton}. (cf. also \ttt{beam},
	\ttt{incoming},
	\ttt{cuts}, \ttt{analysis}, \ttt{selection}, \ttt{record})
	%%%%%
	\item
	\ttt{P} \newline
	Unary (binary) observable specifier for the spatial momentum
	$\sqrt{\vec{p}^2}$ of a single (two) particle(s), e.g. \ttt{eval P
	["W+"]}, \ttt{all P > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
	\ttt{selection})
	%%%%%
	\item
	\ttt{pbarn} \newline
	Physical unit, stating that a number is in picobarns ($10^{-12}$
	barn). (cf. also \ttt{abarn}, \ttt{fbarn}, \ttt{nbarn})
	%%%%%
	\item
	\ttt{pdf\_builtin} \newline
	This is a beams specifier for \whizard's internal PDF structure
	functions to integrate processes in hadron collisions.
	(cf. \ttt{beams}, \ttt{pdf\_builtin\_photon},
	\ttt{\$pdf\_builtin\_file})
	%%%%%
	\item
	\ttt{pdf\_builtin\_photon} \newline
	This is a beams specifier for \whizard's internal PDF structure
	functions to integrate processes in hadron collisions with a photon as
	initializer of the hard scattering process.
	(cf. \ttt{beams}, \ttt{\$pdf\_builtin\_file})
	%%%%%
	\item
	\ttt{PDG} \newline
	Unary observable specifier that allows to specify the PDG code of a
	particle, e.g. \ttt{eval PDG [e1]}, giving \ttt{11}. (cf. also
	\ttt{eval}, \ttt{cuts}, \ttt{selection})
	%%%%%
	\item
	\ttt{Phi} \newline
	Unary and also binary observable specifier, that as a unary observable
	gives the azimuthal angle of a particle's momentum in the detector
	frame (beam into $+z$ direction). As a binary observable, it gives the
	azimuthal difference between the momenta of two particles: \ttt{eval
	Phi [e1]}, \ttt{all Phi > Pi [jet, jet]}. (cf. also \ttt{eval},
	\ttt{cuts}, \ttt{selection}, \ttt{Theta})
	%%%%%
	\item
	\ttt{photon\_isolation} \newline
	Logical function \ttt{photon\_isolation if {\em <condition>} [{\em
	<list1>} , {\em <list2>}]} that cuts out event where the photons in
	\ttt{{\em <list1>}} do not fulfill the condition \ttt{{\em
	<condition>}} and are not isolated from hadronic (and electromagnetic)
	activity, i.e. the photon fragmentation. (cf. also \ttt{cluster},
	\ttt{collect}, \ttt{combine}, \ttt{extract}, \ttt{select},
	\ttt{sort}, \ttt{+})
	%%%%%
	\item
	\ttt{photon\_recombination} \newline
	Similar to the \ttt{cluster} statement takes a subevent as argument
	and combines a (single) photon with the closest non-photon object
	given in the subevent. Depends on the \sindarin\ variable
	\ttt{photon\_rec\_r0} which gives the $R$ radius within which the photon
	is recombined. (cf. also \ttt{cluster}, \ttt{collect}, \ttt{combine})
	%%%%%
	\item
	\ttt{Pl} \newline
	Unary (binary) observable specifier for the longitudinal momentum
	($p_z$ in the c.m. frame) of a single (two) particle(s),
	e.g. \ttt{eval Pl ["W+"]}, \ttt{all Pl > 200 GeV [b,
	B]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
	%%%%%
	\item
	\ttt{plot} \newline
	This command defines the necessary information regarding plotting data
	as a graph, in the form of: \ttt{plot {\em <record\_name>} \{ {\em <optional
	arguments>} \}}. The record with name \ttt{{\em <record\_name>}} has to be
	defined, either before or after the plot definition. Possible optional
	arguments of the \ttt{plot} command are the minimal and maximal values
	of the axes (\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}).
	(cf. \ttt{graph}, \ttt{histogram}, \ttt{record})
	%%%%%
	\item
	\ttt{polarized} \newline
	Constructor to instruct \whizard\ to retain polarization of the
	corresponding particles in the generated events: \ttt{polarized {\em <prt1>}
	[, {\em <prt2>} , ...]}. (cf. also \ttt{unpolarized}, \ttt{simulate},
	\ttt{?polarized\_events})
	%%%%%
	\item
	\ttt{printf} \newline
	Command that allows to print data as screen messages, into logfiles or
	into user-defined output files: \ttt{printf "{\em <string\_expr>}"}. There
	exist format specifiers, very similar to the \ttt{C} command
	\ttt{printf}, e.g. \ttt{printf "\%i" (123)}. (cf. also
	\ttt{open\_out}, \ttt{close\_out}, \ttt{\$out\_file},
	\ttt{?out\_advance}, \ttt{sprintf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e},
	\ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F}, \ttt{\%G}, \ttt{\%s})
	%%%%%
	\item
	\ttt{process} \newline
	Allows to set a hard interaction process, either for a decay process
	with name \ttt{{\em <decay\_proc>}} as \ttt{process {\em
	<decay\_proc>} = {\em <mother>} => {\em <daughter1>}, {\em
	<daughter2>}, ...}, or for a scattering process
	with name \ttt{{\em <scat\_proc}} as \ttt{process {\em <scat\_proc>} =
	{\em <in1>}, {\em <in2>} => {\em <out1>}, {\em <out2>}, ...}. Note
	that there can be arbitrarily many processes to be defined in a
	\sindarin\ input file. There are two options for particle/process sums: flavor sums:
	\ttt{{\em <prt1>}:{\em <prt2>}:...}, where all masses have to be identical, and
	inclusive sums, \ttt{{\em <prt1>} + {\em <prt2>} + ...}. The latter can be done on
	the level of individual particles, or sums over whole final
	states. Here, masses can differ, and terms will be translated into
	different process components. The \ttt{process} command also allows for
	optional arguments, e.g. to specify a numerical identifier
	(cf. \ttt{process\_num\_id}), the method how to generate the code for
	the matrix element(s): \ttt{\$method}, possible methods are either
	with the \oMega\ matrix element generator, using template matrix
	elements with different normalizations, or completely internal matrix
	element; for \oMega\ matrix elements there is also the possibility to
	specify possible restrictions (cf. \ttt{\$restrictions}).
	%%%%%
	\item
	\ttt{prod} \newline
	Takes the product of an expression \ttt{<expr>} over the elements of
	the given subevent \ttt{<subevt>}, \ttt{prod <expr> [<subevt>]}, e.g.
	\ttt{prod Hel [e1:E1]} (cf. \ttt{eval}, \ttt{sum}).
	%%%%%
	\item
	\ttt{Pt} \newline
	Unary (binary) observable specifier for the transverse momentum
	($\sqrt{p_x^2 + p_y^2}$ in the c.m. frame) of a single (two)
	particle(s), e.g. \ttt{eval Pt ["W+"]}, \ttt{all Pt > 200 GeV [b,
	B]}. (cf. \ttt{eval}, \ttt{cuts}, \ttt{selection})
	%%%%%
	\item
	\ttt{Px} \newline
	Unary (binary) observable specifier for the $x$-component of the
	momentum of a single (two) particle(s), e.g. \ttt{eval Px ["W+"]},
	\ttt{all Px > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
	\ttt{selection})
	%%%%%
	\item
	\ttt{Py} \newline
	Unary (binary) observable specifier for the $y$-component of the
	momentum of a single (two) particle(s), e.g. \ttt{eval Py ["W+"]},
	\ttt{all Py > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
	\ttt{selection})
	%%%%%
	\item
	\ttt{Pz} \newline
	Unary (binary) observable specifier for the $z$-component of the
	momentum of a single (two) particle(s), e.g. \ttt{eval Pz ["W+"]},
	\ttt{all Pz > 200 GeV [b, B]}. (cf. \ttt{eval}, \ttt{cuts},
	\ttt{selection})
	%%%%%
	\item
	\ttt{quit} \newline
	Command to finish the \whizard\ run (and not execute any further code
	beyond the appearance of \ttt{quit} in the \sindarin\ file. The command
	(which is the same as $\to$ \ttt{exit}) allows for an argument,
	\ttt{quit ({\em <expr>})}, where the expression can be executed, e.g. a
	screen message or an quit code.
	%%%%%
	\item
	\ttt{rad} \newline
	Expression specifying the physical unit of radians for angular
	variables. This is the default in \whizard. (cf. \ttt{degree}, \ttt{mrad}).
	%%%%%
	\item
	\ttt{Rap} \newline
	Unary and also binary observable specifier, that as a unary observable
	gives the rapidity of a particle momentum. The rapidity is given by $y
	= \frac12 \log \left[ (E + p_z)/(E-p_z) \right]$. As a binary
	observable, it gives the rapidity difference between the momenta of
	two particles: \ttt{eval Rap [e1]}, \ttt{all abs (Rap) < 3.5 [jet,
	jet]}. (cf. also \ttt{eval}, \ttt{cuts}, \ttt{selection}, \ttt{Eta},
	\ttt{abs})
	%%%%%
	\item
	\ttt{read\_slha} \newline
	Tells \whizard\ to read in an input file in the SUSY Les Houches accord
	(SLHA), as \ttt{read\_slha ("slha\_file.slha")}. Note that the files
	for the use in \whizard\ should have the suffix \ttt{.slha}.
	(cf. also \ttt{write\_slha}, \ttt{?slha\_read\_decays},
	\ttt{?slha\_read\_input}, \ttt{?slha\_read\_spectrum})
	%%%%%
	\item
	\ttt{real} \newline
	This is a constructor to specify real constants in the input
	file. Strictly speaking, it is a unary function setting the value
	\ttt{real\_val} of the real variable \ttt{real\_var}:
	\ttt{real {\em <real\_var>} = {\em <real\_val>}}. (cf. also \ttt{int} and
	\ttt{complex})
	%%%%%
	\item
	\ttt{real\_epsilon}\\
	Predefined real; the relative uncertainty intrinsic to the floating
	point type of the \fortran\ compiler with which \whizard\ has been
	built.
	%%%%%
	\item
	\ttt{real\_precision}\\
	Predefined integer; the decimal precision of the floating point type
	of the \fortran\ compiler with which \whizard\ has been built.
	%%%%%
	\item
	\ttt{real\_range}\\
	Predefined integer; the decimal range of the floating point type of
	the \fortran\ compiler with which \whizard\ has been built.
	%%%%%
	\item
	\ttt{real\_tiny}\\
	Predefined real; the smallest number which can be represented by the
	floating point type of the \fortran\ compiler with which \whizard\ has
	been built.
	%%%%%
	\item
	\ttt{record} \newline
	The \ttt{record} constructor provides an internal data structure in
	\sindarin\ input files. Its syntax is in general \ttt{record
	{\em <record\_name>} ({\em <cmd\_expr>})}. The \ttt{{\em <cmd\_expr>}} could be the
	definition of a tuple of points for a histogram or an \ttt{eval}
	constructor that tells \whizard\ e.g. by which rule to calculate an
	observable to be stored in the record \ttt{record\_name}. Example:
	\ttt{record h (12)} is a record for a histogram defined under the name
	\ttt{h} with the single data point (bin) at value 12; \ttt{record rap1
	(eval Rap [e1])} defines a record with name \ttt{rap1} which has an
	evaluator to calculate the rapidity (predefined \whizard\ function) of
	an outgoing electron.
	(cf. also \ttt{eval}, \ttt{histogram}, \ttt{plot})
	%%%%%
	\item
	\ttt{renormalization\_scale} \newline
	This is a command, \ttt{renormalization\_scale = {\em <expr>}}, that sets
	the renormalization scale of a process or list of processes. It
	overwrites a possible scale set by the ($\to$) \ttt{scale} command.
	\ttt{{\em <expr>}} can be any kinematic expression that leads to a result of
	momentum dimension one, e.g. \ttt{100 GeV}, \ttt{eval
	Pt [e1]}. (cf. also \ttt{factorization\_scale}).
	%%%%%
	\item
	\ttt{rescan} \newline
	This command allows to rescan event samples with modified model
	parameter, beam structure etc. to recalculate (analysis) observables,
	e.g.: \newline
	\ttt{rescan "{\em <event\_file>}" ({\em <proc\_name>}) \{ {\em <rescan\_setup>}\}}.
	\newline
	\ttt{"{\em <event\_file>}"} is the name of the event file and
	\ttt{{\em <proc\_name>}} is the process whose (existing) event
	file of arbitrary size that is to be rescanned. Several flags allow to
	reconstruct the beams ($\to$ \ttt{?recover\_beams}), to reuse only the
	hard process but rebuild the full events ($\to$
	\ttt{?update\_event}), to recalculate the matrix element ($\to$
	\ttt{?update\_sqme}) or to recalculate the individual event weight ($\to$
	\ttt{?update\_weight}). Further rescan options are redefining model
	parameter input, or defining a completely new alternative setup ($\to$
	\ttt{alt\_setup}) (cf. also \ttt{\$rescan\_input\_format})
	%%%%%
	\item
	\ttt{results} \newline
	Only used in the combination \ttt{show (results)}. Forces \whizard\ to
	print out a results summary for the integrated processes.
	(cf. also \ttt{show})
	%%%%%
	\item
	\ttt{reweight} \newline
	The \ttt{reweight = {\em <expr>}} command allows to give for a process or
	list of processes an alternative weight, given by any kind of scalar
	expression \ttt{{\em <expr>}}, e.g. \ttt{reweight = 0.2} or \ttt{reweight =
	(eval M2 [e1, E1]) / (eval M2 [e2, E2])}. (cf. also \ttt{alt\_setup},
	\ttt{weight}, \ttt{rescan})
	%%%%%
	\item
	\ttt{sample\_format} \newline
	Variable that allows the user to specify additional event formats
	beyond the \whizard\ native binary event format. Its syntax is
	\ttt{sample\_format = {\em <format>}}, where \ttt{{\em <format>}} can be any of
	the following specifiers: \ttt{hepevt}, \ttt{hepevt\_verb}, \ttt{ascii},
	\ttt{athena}, \ttt{debug}, \ttt{long}, \ttt{short}, \ttt{hepmc},
	\ttt{lhef}, \ttt{lha}, \ttt{lha\_verb}, \ttt{stdhep}, \ttt{stdhep\_up},
	\texttt{lcio}, \texttt{mokka}.
	(cf. also \ttt{\$sample}, \ttt{simulate}, \ttt{hepevt}, \ttt{ascii},
	\ttt{athena}, \ttt{debug}, \ttt{long}, \ttt{short}, \ttt{hepmc},
	\ttt{lhef}, \ttt{lha}, \ttt{stdhep}, \ttt{stdhep\_up}, \texttt{lcio},
	\texttt{mokka}, \ttt{\$sample\_normalization}, \ttt{?sample\_pacify}, \newline
	\ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt}, \ttt{sample\_split\_n\_kbytes})
	%%%%%
	\item
	\ttt{scale} \newline
	This is a command, \ttt{scale = {\em <expr>}}, that sets the kinematic scale
	of a process or list of processes. Unless overwritten explicitly by
	($\to$) \ttt{factorization\_scale} and/or ($\to$)
	\ttt{renormalization\_scale} it sets both scales. \ttt{{\em <expr>}} can be
	any kinematic expression that leads to a result of momentum dimension
	one, e.g. \ttt{scale = 100 GeV}, \ttt{scale = eval Pt [e1]}.
	%%%%%
	\item
	\ttt{scan} \newline
	Constructor to perform loops over variables or scan over processes in
	the integration procedure. The syntax is \ttt{scan {\em <var>} {\em <var\_name>}
	({\em <value list>} or {\em <value\_init>} => {\em <value\_fin>} /{\em <incrementor>}
	{\em <increment>}) \{ {\em <scan\_cmd>} \}}. The variable \ttt{var} can be
	specified if it is not a real, e.g. an integer. \ttt{var\_name} is the
	name of the variable which is also allowed to be a predefined one like
	\ttt{seed}. For the scan, one can either specify an explicit list of
	values \ttt{value list}, or use an initial and final value and a
	rule to increment. The \ttt{scan\_cmd} can either be just a
	\ttt{show} to print out the scanned variable or the integration of a process.
	Examples are: \ttt{scan seed (32 => 1 // 2) \{ show (seed\_value) \}
	}, which runs the seed down in steps 32, 16, 8, 4, 2, 1 (division by
	two). \ttt{scan mW (75 GeV, 80 GeV => 82 GeV /+ 0.5 GeV, 83 GeV => 90
	GeV /* 1.2) \{ show (sw) \} } scans over the $W$ mass for the values
	75, 80, 80.5, 81, 81.5, 82, 83 GeV, namely one discrete value, steps
	by adding 0.5 GeV, and increase by 20 \% (the latter having no effect
	as it already exceeds the final value). It prints out the
	corresponding value of the effective mixing angle which is defined as
	a dependent variable in the model input file(s). \ttt{scan sqrts (500 GeV =>
	600 GeV /+ 10 GeV) \{ integrate (proc) \} } integrates the process
	\ttt{proc} in eleven increasing 10 GeV steps in center-of-mass energy
	from 500 to 600 GeV. (cf. also \ttt{/+}, \ttt{/+/}, \ttt{/-},
	\ttt{/}, \ttt{//}, \ttt{//})
	%%%%%
	\item
	\ttt{select} \newline
	Subevent function \ttt{select if {\em <condition>} [{\em <list1>} [ ,
	{\em <list2>}]]} that selects all particles in \ttt{{\em <list1>}}
	that satisfy the condition \ttt{{\em <condition>}}. The second
	particle list \ttt{{\em <list2>}} is for conditions that depend on
	binary observables. (cf. also \ttt{collect},
	\ttt{combine}, \ttt{extract}, \ttt{sort}, \ttt{+})
	%%%%%
	\item
	\ttt{select\_b\_jet} \newline
	Subevent function \ttt{select if {\em <condition>} [{\em <list1>} [ ,
	{\em <list2>}]]} that selects all particles in \ttt{{\em <list1>}}
	that are $b$ jets and satisfy the condition \ttt{{\em
	<condition>}}. The second particle list \ttt{{\em <list2>}} is for
	conditions that depend on binary observables. (cf. also \ttt{cluster},
	\ttt{collect}, \ttt{combine}, \ttt{extract}, \ttt{select},
	\ttt{sort}, \ttt{+})
	%%%%%
	\item
	\ttt{select\_c\_jet} \newline
	Subevent function \ttt{select if {\em <condition>} [{\em <list1>} [ ,
	{\em <list2>}]]} that selects all particles in \ttt{{\em <list1>}}
	that are $c$ jets (but {\em not} $b$ jets) and satisfy the condition
	\ttt{{\em <condition>}}. The second particle list \ttt{{\em <list2>}}
	is for conditions that depend on binary observables. (cf. also
	\ttt{cluster}, \ttt{collect}, \ttt{combine}, \ttt{extract},
	\ttt{select}, \ttt{sort}, \ttt{+})
	%%%%%
	\item
	\ttt{select\_light\_jet} \newline
	Subevent function \ttt{select if {\em <condition>} [{\em <list1>} [ ,
	{\em <list2>}]]} that selects all particles in \ttt{{\em <list1>}}
	that are light(-flavor) jets and satisfy the condition
	\ttt{{\em <condition>}}. The second particle list \ttt{{\em <list2>}}
	is for conditions that depend on binary observables. (cf. also
	\ttt{cluster}, \ttt{collect}, \ttt{combine}, \ttt{extract},
	\ttt{select}, \ttt{sort}, \ttt{+})
	%%%%%
	\item
	\ttt{select\_non\_b\_jet} \newline
	Subevent function \ttt{select if {\em <condition>} [{\em <list1>} [ ,
	{\em <list2>}]]} that selects all particles in \ttt{{\em <list1>}}
	that are {\em not} $b$ jets ($c$ and light jets) and satisfy the
	condition \ttt{{\em <condition>}}. The second particle list \ttt{{\em
	<list2>}} is for conditions that depend on binary
	observables. (cf. also \ttt{cluster}, \ttt{collect}, \ttt{combine},
	\ttt{extract}, \ttt{select}, \ttt{sort}, \ttt{+})
	%%%%%
	\item
	\ttt{selection} \newline
	Command that allows to select particular final states in an analysis
	selection, \ttt{selection = {\em <log\_expr>}}. The term \ttt{log\_expr} can
	be any kind of logical expression. The syntax matches exactly
	the one of the ($\to$) \ttt{cuts} command. E.g. \ttt{selection = any
	PDG == 13} is an electron selection in a lepton sample.
	%%%%%
	\item
	\ttt{sgn} \newline
	Numerical function for integer and real numbers that gives the sign of
	its argument: \ttt{sgn ({\em <num\_val>})} yields $+1$ if \ttt{{\em
	<num\_val>}} is positive or zero, and $-1$ otherwise. (cf. also
	\ttt{abs}, \ttt{conjg}, \ttt{mod}, \ttt{modulo})
	%%%%%
	\item
	\ttt{short} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of the short variant of HEPEVT ASCII event
	files. (cf. also \ttt{\$sample}, \ttt{sample\_format})
	%%%%%
	\item
	\ttt{show} \newline
	This is a unary function that is operating on specific constructors in
	order to print them out in the \whizard\ screen output as well as the
	log file \ttt{whizard.log}. Examples are \ttt{show({\em <parameter\_name>})}
	to issue a specific parameter from a model or a constant defined in a
	\sindarin\ input file, \ttt{show(integral({\em <proc\_name>}))},
	\ttt{show(library)}, \ttt{show(results)}, or \ttt{show({\em <var>})} for any
	arbitrary variable. Further possibilities are \ttt{show(real)},
	\ttt{show(string)}, \ttt{show(logical)} etc. to allow to show all
	defined real, string, logical etc. variables, respectively.
	(cf. also \ttt{library}, \ttt{results})
	%%%%%
	\item
	\ttt{simulate} \newline
	This command invokes the generation of events for the process
	\ttt{proc} by means of \ttt{simulate ({\em <proc>})}.
	Optional arguments: \ttt{\$sample}, \ttt{sample\_format},
	\ttt{checkpoint} (cf. also \ttt{integrate}, \ttt{luminosity},
	\ttt{n\_events}, \ttt{\$sample}, \ttt{sample\_format},
	\ttt{checkpoint}, \ttt{?unweighted}, \ttt{safety\_factor},
	\ttt{?negative\_weights}, \ttt{sample\_max\_tries},
	\ttt{sample\_split\_n\_evt}, \ttt{sample\_split\_n\_kbytes})
	%%%%%
	\item
	\ttt{sin} \newline
	Numerical function \ttt{sin ({\em <num\_val>})} that calculates the
	sine trigonometric function of real and complex numerical numbers or
	variables. (cf. also \ttt{cos}, \ttt{tan}, \ttt{asin}, \ttt{acos},
	\ttt{atan})
	%%%%%
	\item
	\ttt{sinh} \newline
	Numerical function \ttt{sinh ({\em <num\_val>})} that calculates the
	hyperbolic sine function of real and complex numerical numbers or
	variables. Note that its inverse function is part of the
	\ttt{Fortran2008} status and hence not realized. (cf. also \ttt{cosh},
	\ttt{tanh})
	%%%%%
	\item
	\ttt{sort} \newline
	Subevent function that allows to sort a particle list/subevent either
	by increasing PDG code: \ttt{sort [{\em <particles>}]} (particles
	first, then antiparticles). Alternatively, it can sort according to a
	unary or binary particle observable (in that case there is a second
	particle list, where the first particle is taken as a reference):
	\ttt{sort by {\em <observable>} [{\em <particles>} [, {\em
	<ref\_particles>}]]}. (cf. also \ttt{extract}, \ttt{combine},
	\ttt{collect}, \ttt{join}, \ttt{by}, \ttt{+})
	%%%%%
	\item
	\ttt{sprintf} \newline
	Command that allows to print data into a string variable: \ttt{sprintf
	"{\em <string\_expr>}"}. There exist format specifiers, very similar
	to the \ttt{C} command \ttt{sprintf}, e.g. \ttt{sprintf "\%i"
	(123)}. (cf. \ttt{printf}, \ttt{\%d}, \ttt{\%i}, \ttt{\%e},
	\ttt{\%f}, \ttt{\%g}, \ttt{\%E}, \ttt{\%F}, \ttt{\%G}, \ttt{\%s})
	%%%%%
	\item
	\ttt{sqrt} \newline
	Numerical function \ttt{sqrt ({\em <num\_val>})} that calculates the
	square root of real and complex numerical numbers or
	variables. (cf. also \ttt{exp}, \ttt{log}, \ttt{log10})
	%%%%%
	\item
	\ttt{sqrts\_hat} \newline
	Real variable that accesses the partonic energy of a hard-scattering
	process. It can be used in cuts or in an analysis, e.g. \ttt{cuts =
	sqrts\_hat > {\em <num>} [ {\em <phys\_unit>} ]}. The physical unit
	can be one of the following \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{GeV},
	and \ttt{TeV}. (cf. also \ttt{sqrts}, \ttt{cuts}, \ttt{record})
	%%%%%
	\item
	\ttt{stable} \newline
	This constructor allows particles in the final states of processes in
	decay cascade set-up to be set as stable, and not letting them
	decay. The syntax is \ttt{stable {\em <prt\_name>}} (cf. also \ttt{unstable})
	%%%%%
	\item
	\ttt{stdhep} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of binary StdHEP event files based on the HEPEVT common
	block. (cf. also \ttt{\$sample}, \ttt{sample\_format})
	%%%%%
	\item
	\ttt{stdhep\_up} \newline
	Specifier for the \ttt{sample\_format} command to demand the
	generation of binary StdHEP event files based on the HEPRUP/HEPEUP common
	blocks. (cf. also \ttt{\$sample}, \ttt{sample\_format})
	%%%%%
	\item
	\ttt{sum} \newline
	Takes the sum of an expression \ttt{<expr>} over the elements of
	the given subevent \ttt{<subevt>}, \ttt{sum <expr> [<subevt>]}, e.g.
	\ttt{sum Pt/2 [jets]} (cf. \ttt{eval}, \ttt{prod}).
	%%%%%
	\item
	\ttt{tan} \newline
	Numerical function \ttt{tan ({\em <num\_val>})} that calculates the
	tangent trigonometric function of real and complex numerical numbers or
	variables. (cf. also \ttt{sin}, \ttt{cos}, \ttt{asin}, \ttt{acos},
	\ttt{atan})
	%%%%%
	\item
	\ttt{tanh} \newline
	Numerical function \ttt{tanh ({\em <num\_val>})} that calculates the
	hyperbolic tangent function of real and complex numerical numbers or
	variables. Note that its inverse function is part of the
	\ttt{Fortran2008} status and hence not realized. (cf. also \ttt{cosh},
	\ttt{sinh})
	%%%%%
	\item
	\ttt{TeV} \newline
	Physical unit, for energies in $10^{12}$ electron volt. (cf. also
	\ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{meV}, \ttt{GeV})
	%%%%
	\item
	\ttt{then} \newline
	Mandatory phrase in a conditional clause: \ttt{if {\em <log\_expr>} then
	{\em <expr 1>} \ldots endif}. (cf. also \ttt{if}, \ttt{else}, \ttt{elsif},
	\ttt{endif}).
	%%%%%
	\item
	\ttt{Theta} \newline
	Unary and also binary observable specifier, that as a unary observable
	gives the angle between a particle's momentum and the beam axis ($+z$
	direction). As a binary observable, it gives the angle enclosed
	between the momenta of the two particles: \ttt{eval Theta [e1]},
	\ttt{all Theta > 30 degrees [jet, jet]}. (cf. also \ttt{eval},
	\ttt{cuts}, \ttt{selection}, \ttt{Phi}, \ttt{Theta\_star})
	%%%%%
	\item
	\ttt{Theta\_star} \newline
	Binary observable specifier, that gives the polar angle enclosed
	between the momenta of the two particles in the rest frame of the
	mother particle (momentum sum of the two particle): \ttt{eval
	Theta\_star [jet, jet]}. (cf. also \ttt{eval},
	\ttt{cuts}, \ttt{selection}, \ttt{Theta})
	%%%%%
	\item
	\ttt{true} \newline
	Constructor stating that a logical expression or variable is true,
	e.g. \ttt{?{\em <log\_var>} = true}. (cf. also \ttt{false}).
	%%%%%
	\item
	\ttt{unpolarized} \newline
	Constructor to force \whizard\ to discard polarization of the
	corresponding particles in the generated events: \ttt{unpolarized {\em <prt1>}
	[, {\em <prt2>} , ...]}. (cf. also \ttt{polarized}, \ttt{simulate},
	\ttt{?polarized\_events})
	%%%%%
	\item
	\ttt{unstable} \newline
	This constructor allows to let final state particles of the hard
	interaction undergo a subsequent (cascade) decay (in the on-shell
	approximation). For this the user has to define the list of desired
	\begin{figure}
	\begin{Verbatim}[frame=single]
	process zee = Z => e1, E1
	process zuu = Z => u, U
	process zz = e1, E1 => Z, Z
	compile
	integrate (zee) { iterations = 1:100 }
	integrate (zuu) { iterations = 1:100 }
	sqrts = 500 GeV
	integrate (zz) { iterations = 3:5000, 2:5000 }
	unstable Z (zee, zuu)
	\end{Verbatim}
	\caption{\label{fig:ex_unstable} \sindarin\ input file for unstable
	particles and inclusive decays.}
	\end{figure}
	decay channels as \ttt{unstable {\em <mother>} ({\em <decay1>}, {\em <decay2>}, ....)},
	where \ttt{mother} is the mother particle, and the argument is a list
	of decay channels. Note that -- unless the \ttt{?auto\_decays = true}
	flag has been set -- these decay channels have to be provided by the
	user as in the example in Fig. \ref{fig:ex_unstable}. First, the $Z$
	decays to electrons and up quarks are generated, then $ZZ$ production
	at a 500 GeV ILC is called, and then both $Z$s are decayed according
	to the probability distribution of the two generated decay matrix
	elements. This obviously allows also for inclusive decays.
	(cf. also \ttt{stable}, \ttt{?auto\_decays})
	%%%%%
	\item
	\ttt{weight} \newline
	This is a command, \ttt{weight = {\em <expr>}}, that allows to specify a
	weight for a process or list of processes. \ttt{{\em <expr>}} can be
	any expression that leads to a scalar result, e.g. \ttt{weight = 0.2},
	\ttt{weight = eval Pt [jet]}. (cf. also \ttt{rescan},
	\ttt{alt\_setup}, \ttt{reweight})
	%%%%%
	\item
	\ttt{write\_analysis} \newline
	The \ttt{write\_analysis} statement tells \whizard\ to write the
	analysis setup by the user for the \sindarin\ input file under
	consideration. If no \ttt{\$out\_file} is provided, the histogram
	tables/plot data etc. are written to the default file
	\ttt{whizard\_analysis.dat}. Note that the related command
	\ttt{compile\_analysis} does the same as \ttt{write\_analysis} but in
	addition invokes the \whizard\ \LaTeX routines for producing
	postscript or PDF output of the data.
	(cf. also \ttt{\$out\_file}, \ttt{compile\_analysis})
	%%%%%
	\item
	\ttt{write\_slha} \newline
	Demands \whizard\ to write out a file in the SUSY Les Houches accord
	(SLHA) format. (cf. also \ttt{read\_slha}, \ttt{?slha\_read\_decays},
	\ttt{?slha\_read\_input}, \ttt{?slha\_read\_spectrum})
	%%%%%
	\end{itemize}
	\section{Variables}
	\subsection{Rebuild Variables}
	\begin{itemize}
	\item
	\ttt{?rebuild\_events} \qquad (default: \ttt{false}) \newline
	This logical variable, if set \ttt{true} triggers \whizard\ to newly
	create an event sample, even if nothing seems to have changed,
	including the MD5 checksum. This can be used when manually
	manipulating some settings. (cf also \ttt{?rebuild\_grids},
	\ttt{?rebuild\_library}, \ttt{?rebuild\_phase\_space})
	%%%%%
	\item
	\ttt{?rebuild\_grids} \qquad (default: \ttt{false}) \newline
	The logical variable \ttt{?rebuild\_grids} forces \whizard\ to newly
	create the VAMP grids when using VAMP as an integration method, even
	if they are already present. (cf. also \ttt{?rebuild\_events},
	\ttt{?rebuild\_library}, \ttt{?rebuild\_phase\_space})
	%%%%%
	\item
	\ttt{?rebuild\_library} \qquad (default: \ttt{false}) \newline
	The logical variable \ttt{?rebuild\_library = true/false} specifies
	whether the library(-ies) for the matrix element code for processes is
	re-generated (incl. possible Makefiles etc.) by the corresponding ME
	method (e.g. if the process has been changed, but not its name). This
	can also be set as a command-line option \ttt{whizard --rebuild}. The
	default is \ttt{false}, i.e. code is never re-generated if it is
	present and the MD5 checksum is valid.
	(cf. also \ttt{?recompile\_library}, \ttt{?rebuild\_grids},
	\ttt{?rebuild\_phase\_space})
	%%%%%
	\item
	\ttt{?rebuild\_phase\_space} \qquad (default: \ttt{false}) \newline
	This logical variable, if set \ttt{true}, triggers recreation of the
	phase space file by \whizard\. (cf. also \ttt{?rebuild\_events},
	\ttt{?rebuild\_grids}, \ttt{?rebuild\_library})
	%%%%%
	\item
	\ttt{?recompile\_library} \qquad (default: \ttt{false}) \newline
	The logical variable \ttt{?recompile\_library = true/false} specifies
	whether the library(-ies) for the matrix element code for processes is
	re-compiled (e.g. if the process code has been manually modified by
	the user). This can also be set as a command-line option \ttt{whizard
	--recompile}. The default is \ttt{false}, i.e. code is never
	re-compiled if its corresponding object file is present. (cf. also
	\ttt{?rebuild\_library})
	%%%%%
	\end{itemize}
	\subsection{Standard Variables}
	\begin{itemize}
	\input{variables}
	\end{itemize}

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\clearpage
	\section*{Acknowledgements}

	We would like to thank E.~Boos, R.~Chierici, K.~Desch, M.~Kobel,
	F.~Krauss, P.M.~Manakos, N.~Meyer, K.~M\"onig, H.~Reuter, T.~Robens,
	S.~Rosati, J.~Schumacher, M.~Schumacher, and C.~Schwinn who
	contributed to \whizard\ by their suggestions, bits of codes and
	valuable remarks and/or used several versions of the program for
	real-life applications and thus helped a lot in debugging and
	improving the code. Special thanks go to A.~Vaught and J.~Weill for
	their continuos efforts on improving the g95 and gfortran compilers,
	respectively.

	%\end{fmffile}
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%%% References
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	%\baselineskip15pt
	\begin{thebibliography}{19}

	\bibitem{PYTHIA}
	T.~Sj\"ostrand,
	Comput.\ Phys.\ Commun.\ \textbf{82} (1994) 74.

	\bibitem{comphep}
	A.~Pukhov, \emph{et al.},
	Preprint INP MSU 98-41/542, \ttt{hep-ph/9908288}.

	\bibitem{madgraph}
	T.~Stelzer and W.F.~Long,
	Comput.\ Phys.\ Commun.\ \textbf{81} (1994) 357.

	\bibitem{omega}
	T.~Ohl,
	\emph{Proceedings of the Seventh International Workshop on
	Advanced Computing and Analysis Technics in Physics Research},
	ACAT 2000, Fermilab, October 2000,
	IKDA-2000-30, \ttt{hep-ph/0011243};
	M.~Moretti, Th.~Ohl, and J.~Reuter,
	LC-TOOL-2001-040

	\bibitem{VAMP}
	T.~Ohl,
	{\em Vegas revisited: Adaptive Monte Carlo integration beyond
	factorization},
	Comput.\ Phys.\ Commun.\ {\bf 120}, 13 (1999)
	[arXiv:hep-ph/9806432].
	%%CITATION = CPHCB,120,13;%%

	\bibitem{CIRCE}
	T.~Ohl,
	{\em CIRCE version 1.0: Beam spectra for simulating linear collider
	physics},
	Comput.\ Phys.\ Commun.\ {\bf 101}, 269 (1997)
	[arXiv:hep-ph/9607454].
	%%CITATION = CPHCB,101,269;%%

	%\cite{Gribov:1972rt}
	\bibitem{Gribov:1972rt}
	V.~N.~Gribov and L.~N.~Lipatov,
	{\em e+ e- pair annihilation and deep inelastic e p scattering in
	perturbation theory},
	Sov.\ J.\ Nucl.\ Phys.\ {\bf 15}, 675 (1972)
	[Yad.\ Fiz.\ {\bf 15}, 1218 (1972)].
	%%CITATION = SJNCA,15,675;%%

	%\cite{Kuraev:1985hb}
	\bibitem{Kuraev:1985hb}
	E.~A.~Kuraev and V.~S.~Fadin,
	{\em On Radiative Corrections to e+ e- Single Photon Annihilation at
	High-Energy},
	Sov.\ J.\ Nucl.\ Phys.\ {\bf 41}, 466 (1985)
	[Yad.\ Fiz.\ {\bf 41}, 733 (1985)].
	%%CITATION = SJNCA,41,466;%%

	%\cite{Skrzypek:1990qs}
	\bibitem{Skrzypek:1990qs}
	M.~Skrzypek and S.~Jadach,
	{\em Exact and approximate solutions for the electron nonsinglet
	structure function in QED},
	Z.\ Phys.\ C {\bf 49}, 577 (1991).
	%%CITATION = ZEPYA,C49,577;%%

	%\cite{Schulte:1998au}
	\bibitem{Schulte:1998au}
	D.~Schulte,
	{\em Beam-beam simulations with Guinea-Pig},
	eConf C {\bf 980914}, 127 (1998).
	%%CITATION = ECONF,C980914,127;%%

	%\cite{Schulte:1999tx}
	\bibitem{Schulte:1999tx}
	D.~Schulte,
	{\em Beam-beam simulations with GUINEA-PIG},
	CERN-PS-99-014-LP.
	%%CITATION = CERN-PS-99-014-LP;%%

	%\cite{Schulte:2007zz}
	\bibitem{Schulte:2007zz}
	D.~Schulte, M.~Alabau, P.~Bambade, O.~Dadoun, G.~Le Meur, C.~Rimbault and F.~Touze,
	{\em GUINEA PIG++ : An Upgraded Version of the Linear Collider Beam
	Beam Interaction Simulation Code GUINEA PIG},
	Conf.\ Proc.\ C {\bf 070625}, 2728 (2007).
	%%CITATION = CONFP,C070625,2728;%%

	%\cite{Behnke:2013xla}
	\bibitem{Behnke:2013xla}
	T.~Behnke, J.~E.~Brau, B.~Foster, J.~Fuster, M.~Harrison, J.~M.~Paterson, M.~Peskin and M.~Stanitzki {\it et al.},
	{\em The International Linear Collider Technical Design Report -
	Volume 1: Executive Summary},
	arXiv:1306.6327 [physics.acc-ph].
	%%CITATION = ARXIV:1306.6327;%%

	%\cite{Baer:2013cma}
	\bibitem{Baer:2013cma}
	H.~Baer, T.~Barklow, K.~Fujii, Y.~Gao, A.~Hoang, S.~Kanemura, J.~List and H.~E.~Logan {\it et al.},
	{\em The International Linear Collider Technical Design Report -
	Volume 2: Physics},
	arXiv:1306.6352 [hep-ph].
	%%CITATION = ARXIV:1306.6352;%%

	%\cite{Adolphsen:2013jya}
	\bibitem{Adolphsen:2013jya}
	C.~Adolphsen, M.~Barone, B.~Barish, K.~Buesser, P.~Burrows, J.~Carwardine, J.~Clark and H\'{e}l\`{e}n.~M.~Durand {\it et al.},
	{\em The International Linear Collider Technical Design Report -
	Volume 3.I: Accelerator \& in the Technical Design Phase},
	arXiv:1306.6353 [physics.acc-ph].
	%%CITATION = ARXIV:1306.6353;%%

	%\cite{Adolphsen:2013kya}
	\bibitem{Adolphsen:2013kya}
	C.~Adolphsen, M.~Barone, B.~Barish, K.~Buesser, P.~Burrows, J.~Carwardine, J.~Clark and H\'{e}l\`{e}n.~M.~Durand {\it et al.},
	{\em The International Linear Collider Technical Design Report -
	Volume 3.II: Accelerator Baseline Design},
	arXiv:1306.6328 [physics.acc-ph].
	%%CITATION = ARXIV:1306.6328;%%

	%\cite{Behnke:2013lya}
	\bibitem{Behnke:2013lya}
	T.~Behnke, J.~E.~Brau, P.~N.~Burrows, J.~Fuster, M.~Peskin, M.~Stanitzki, Y.~Sugimoto and S.~Yamada {\it et al.},
	%``The International Linear Collider Technical Design Report - Volume 4: Detectors,''
	arXiv:1306.6329 [physics.ins-det].
	%%CITATION = ARXIV:1306.6329;%%

	%\cite{Aicheler:2012bya}
	\bibitem{Aicheler:2012bya}
	M.~Aicheler, P.~Burrows, M.~Draper, T.~Garvey, P.~Lebrun, K.~Peach and N.~Phinney {\it et al.},
	{\em A Multi-TeV Linear Collider Based on CLIC Technology : CLIC
	Conceptual Design Report},
	CERN-2012-007.
	%%CITATION = CERN-2012-007;%%

	%\cite{Lebrun:2012hj}
	\bibitem{Lebrun:2012hj}
	P.~Lebrun, L.~Linssen, A.~Lucaci-Timoce, D.~Schulte, F.~Simon, S.~Stapnes, N.~Toge and H.~Weerts {\it et al.},
	{\em The CLIC Programme: Towards a Staged e+e- Linear Collider
	Exploring the Terascale : CLIC Conceptual Design Report},
	arXiv:1209.2543 [physics.ins-det].
	%%CITATION = ARXIV:1209.2543;%%

	%\cite{Linssen:2012hp}
	\bibitem{Linssen:2012hp}
	L.~Linssen, A.~Miyamoto, M.~Stanitzki and H.~Weerts,
	{\em Physics and Detectors at CLIC: CLIC Conceptual Design Report},
	arXiv:1202.5940 [physics.ins-det].
	%%CITATION = ARXIV:1202.5940;%%

	%\cite{vonWeizsacker:1934sx}
	\bibitem{vonWeizsacker:1934sx}
	C.~F.~von Weizs\"acker,
	{\em Radiation emitted in collisions of very fast electrons},
	Z.\ Phys.\ {\bf 88}, 612 (1934).
	%%CITATION = ZEPYA,88,612;%%

	%\cite{Williams:1934ad}
	\bibitem{Williams:1934ad}
	E.~J.~Williams,
	{\em Nature of the high-energy particles of penetrating radiation
	and status of ionization and radiation formulae},
	Phys.\ Rev.\ {\bf 45}, 729 (1934).
	%%CITATION = PHRVA,45,729;%%

	%\cite{Budnev:1974de}
	\bibitem{Budnev:1974de}
	V.~M.~Budnev, I.~F.~Ginzburg, G.~V.~Meledin and V.~G.~Serbo,
	{\em The Two photon particle production mechanism. Physical problems.
	Applications. Equivalent photon approximation},
	Phys.\ Rept.\ {\bf 15} (1974) 181.
	%%CITATION = PRPLC,15,181;%%

	%\cite{Ginzburg:1981vm}
	\bibitem{Ginzburg:1981vm}
	I.~F.~Ginzburg, G.~L.~Kotkin, V.~G.~Serbo and V.~I.~Telnov,
	{\em Colliding gamma e and gamma gamma Beams Based on the Single
	Pass Accelerators (of Vlepp Type)},
	Nucl.\ Instrum.\ Meth.\ {\bf 205}, 47 (1983).
	%%CITATION = NUIMA,205,47;%%

	%\cite{Telnov:1989sd}
	\bibitem{Telnov:1989sd}
	V.~I.~Telnov,
	{\em Problems of Obtaining $\gamma \gamma$ and $\gamma \epsilon$
	Colliding Beams at Linear Colliders},
	Nucl.\ Instrum.\ Meth.\ A {\bf 294}, 72 (1990).
	%%CITATION = NUIMA,A294,72;%%

	%\cite{Telnov:1995hc}
	\bibitem{Telnov:1995hc}
	V.~I.~Telnov,
	{\em Principles of photon colliders},
	Nucl.\ Instrum.\ Meth.\ A {\bf 355}, 3 (1995).
	%%CITATION = NUIMA,A355,3;%%

	%\cite{AguilarSaavedra:2001rg}
	\bibitem{AguilarSaavedra:2001rg}
	J.~A.~Aguilar-Saavedra {\it et al.} [ECFA/DESY LC Physics Working
	Group Collaboration],
	{\em TESLA: The Superconducting electron positron linear collider
	with an integrated x-ray laser laboratory. Technical design
	report. Part 3. Physics at an e+ e- linear collider},
	hep-ph/0106315.
	%%CITATION = HEP-PH/0106315;%%

	%\cite{Richard:2001qm}
	\bibitem{Richard:2001qm}
	F.~Richard, J.~R.~Schneider, D.~Trines and A.~Wagner,
	{\em TESLA, The Superconducting Electron Positron Linear Collider
	with an Integrated X-ray Laser Laboratory, Technical Design Report
	Part 1 : Executive Summary},
	hep-ph/0106314.
	%%CITATION = HEP-PH/0106314;%%

	%\cite{Sudakov:1954sw}
	\bibitem{Sudakov:1954sw}
	V.~V.~Sudakov,
	%``Vertex parts at very high-energies in quantum electrodynamics,''
	Sov.\ Phys.\ JETP {\bf 3}, 65 (1956)
	[Zh.\ Eksp.\ Teor.\ Fiz.\ {\bf 30}, 87 (1956)].
	%%CITATION = SPHJA,3,65;%%

	\cite{Sjostrand:1985xi}
	\bibitem{Sjostrand:1985xi}
	T.~Sjostrand,
	%``A Model for Initial State Parton Showers,''
	Phys.\ Lett.\ {\bf 157B}, 321 (1985).
	doi:10.1016/0370-2693(85)90674-4
	%%CITATION = doi:10.1016/0370-2693(85)90674-4;%%

	%\cite{Sjostrand:2006za}
	\bibitem{Sjostrand:2006za}
	T.~Sjostrand, S.~Mrenna and P.~Z.~Skands,
	%``PYTHIA 6.4 Physics and Manual,''
	JHEP {\bf 0605}, 026 (2006)
	doi:10.1088/1126-6708/2006/05/026
	[hep-ph/0603175].
	%%CITATION = doi:10.1088/1126-6708/2006/05/026;%%

	%\cite{Ohl:1998jn}
	\bibitem{Ohl:1998jn}
	T.~Ohl,
	{\em Vegas revisited: Adaptive Monte Carlo integration beyond
	factorization},
	Comput.\ Phys.\ Commun.\ {\bf 120}, 13 (1999)
	[hep-ph/9806432].
	%%CITATION = HEP-PH/9806432;%%

	%\cite{Lepage:1980dq}
	\bibitem{Lepage:1980dq}
	G.~P.~Lepage,
	%``Vegas: An Adaptive Multidimensional Integration Program,''
	CLNS-80/447.
	%%CITATION = CLNS-80/447;%%

	\bibitem{HDECAY}
	A.~Djouadi, J.~Kalinowski, M.~Spira,
	Comput.\ Phys.\ Commun.\ \textbf{108} (1998) 56-74.

	%\cite{Beyer:2006hx}
	\bibitem{Beyer:2006hx}
	M.~Beyer, W.~Kilian, P.~Krstono\v{s}ic, K.~M\"onig, J.~Reuter, E.~Schmidt
	and H.~Schr\"oder,
	{\em Determination of New Electroweak Parameters at the ILC -
	Sensitivity to New Physics},
	Eur.\ Phys.\ J.\ C {\bf 48}, 353 (2006)
	[hep-ph/0604048].
	%%CITATION = HEP-PH/0604048;%%

	%\cite{Alboteanu:2008my}
	\bibitem{Alboteanu:2008my}
	A.~Alboteanu, W.~Kilian and J.~Reuter,
	{\em Resonances and Unitarity in Weak Boson Scattering at the LHC},
	JHEP {\bf 0811}, 010 (2008)
	[arXiv:0806.4145 [hep-ph]].
	%%CITATION = ARXIV:0806.4145;%%

	%\cite{Binoth:2010xt}
	\bibitem{Binoth:2010xt}
	T.~Binoth {\it et al.},
	%``A Proposal for a standard interface between Monte Carlo tools and one-loop programs,''
	Comput.\ Phys.\ Commun.\ {\bf 181}, 1612 (2010)
	doi:10.1016/j.cpc.2010.05.016
	[arXiv:1001.1307 [hep-ph]].
	%%CITATION = doi:10.1016/j.cpc.2010.05.016;%%

	%\cite{Alioli:2013nda}
	\bibitem{Alioli:2013nda}
	S.~Alioli {\it et al.},
	%``Update of the Binoth Les Houches Accord for a standard interface
	%between Monte Carlo tools and one-loop programs,''
	Comput.\ Phys.\ Commun.\ {\bf 185}, 560 (2014)
	doi:10.1016/j.cpc.2013.10.020
	[arXiv:1308.3462 [hep-ph]].
	%%CITATION = doi:10.1016/j.cpc.2013.10.020;%%

	%\cite{Speckner:2010zi}
	\bibitem{Speckner:2010zi}
	C.~Speckner,
	{\em LHC Phenomenology of the Three-Site Higgsless Model},
	PhD thesis, arXiv:1011.1851 [hep-ph].
	%%CITATION = ARXIV:1011.1851;%%

	%\cite{Chivukula:2006cg}
	\bibitem{Chivukula:2006cg}
	R.~S.~Chivukula, B.~Coleppa, S.~Di Chiara, E.~H.~Simmons, H.~-J.~He,
	M.~Kurachi and M.~Tanabashi,
	{\em A Three Site Higgsless Model},
	Phys.\ Rev.\ D {\bf 74}, 075011 (2006)
	[hep-ph/0607124].
	%%CITATION = HEP-PH/0607124;%%

	%\cite{Chivukula:2005xm}
	\bibitem{Chivukula:2005xm}
	R.~S.~Chivukula, E.~H.~Simmons, H.~-J.~He, M.~Kurachi and M.~Tanabashi,
	{\em Ideal fermion delocalization in Higgsless models},
	Phys.\ Rev.\ D {\bf 72}, 015008 (2005)
	[hep-ph/0504114].
	%%CITATION = HEP-PH/0504114;%%

	%\cite{Ohl:2008ri}
	\bibitem{Ohl:2008ri}
	T.~Ohl and C.~Speckner,
	{\em Production of Almost Fermiophobic Gauge Bosons in the Minimal
	Higgsless Model at the LHC},
	Phys.\ Rev.\ D {\bf 78}, 095008 (2008)
	[arXiv:0809.0023 [hep-ph]].
	%%CITATION = ARXIV:0809.0023;%%

	%\cite{Ohl:2002jp}
	\bibitem{Ohl:2002jp}
	T.~Ohl and J.~Reuter,
	{\em Clockwork SUSY: Supersymmetric Ward and Slavnov-Taylor
	identities at work in Green's functions and scattering
	amplitudes},
	Eur.\ Phys.\ J.\ C {\bf 30}, 525 (2003)
	[hep-th/0212224].
	%%CITATION = HEP-TH/0212224;%%

	%\cite{Reuter:2009ex}
	\bibitem{Reuter:2009ex}
	J.~Reuter and F.~Braam,
	{\em The NMSSM implementation in WHIZARD},
	AIP Conf.\ Proc.\ {\bf 1200}, 470 (2010)
	[arXiv:0909.3059 [hep-ph]].
	%%CITATION = ARXIV:0909.3059;%%

	%\cite{Kalinowski:2008fk}
	\bibitem{Kalinowski:2008fk}
	J.~Kalinowski, W.~Kilian, J.~Reuter, T.~Robens and K.~Rolbiecki,
	{\em Pinning down the Invisible Sneutrino},
	JHEP {\bf 0810}, 090 (2008)
	[arXiv:0809.3997 [hep-ph]].
	%%CITATION = ARXIV:0809.3997;%%

	%\cite{Robens:2008sa}
	\bibitem{Robens:2008sa}
	T.~Robens, J.~Kalinowski, K.~Rolbiecki, W.~Kilian and J.~Reuter,
	{\em (N)LO Simulation of Chargino Production and Decay},
	Acta Phys.\ Polon.\ B {\bf 39}, 1705 (2008)
	[arXiv:0803.4161 [hep-ph]].
	%%CITATION = ARXIV:0803.4161;%%

	%\cite{Kilian:2004pp}
	\bibitem{Kilian:2004pp}
	W.~Kilian, D.~Rainwater and J.~Reuter,
	{\em Pseudo-axions in little Higgs models},
	Phys.\ Rev.\ D {\bf 71}, 015008 (2005)
	[hep-ph/0411213].
	%%CITATION = HEP-PH/0411213;%%

	%\cite{Kilian:2006eh}
	\bibitem{Kilian:2006eh}
	W.~Kilian, D.~Rainwater and J.~Reuter,
	{\em Distinguishing little-Higgs product and simple group models at
	the LHC and ILC},
	Phys.\ Rev.\ D {\bf 74}, 095003 (2006)
	[Erratum-ibid.\ D {\bf 74}, 099905 (2006)]
	[hep-ph/0609119].
	%%CITATION = HEP-PH/0609119;%%

	%\cite{Ohl:2004tn}
	\bibitem{Ohl:2004tn}
	T.~Ohl and J.~Reuter,
	{\em Testing the noncommutative standard model at a future photon
	collider},
	Phys.\ Rev.\ D {\bf 70}, 076007 (2004)
	[hep-ph/0406098].
	%%CITATION = HEP-PH/0406098;%%

	%\cite{Ohl:2010zf}
	\bibitem{Ohl:2010zf}
	T.~Ohl and C.~Speckner,
	{\em The Noncommutative Standard Model and Polarization in Charged
	Gauge Boson Production at the LHC},
	Phys.\ Rev.\ D {\bf 82}, 116011 (2010)
	[arXiv:1008.4710 [hep-ph]].
	%%CITATION = ARXIV:1008.4710;%%

	\bibitem{LesHouches}
	E.~Boos {\it et al.},
	{\em Generic user process interface for event generators},
	arXiv:hep-ph/0109068.
	%%CITATION = HEP-PH/0109068;%%

	\bibitem{Skands:2003cj}
	P.~Z.~Skands {\it et al.},
	{\em SUSY Les Houches Accord: Interfacing SUSY Spectrum Calculators, Decay
	Packages, and Event Generators},
	JHEP {\bf 0407}, 036 (2004)
	[arXiv:hep-ph/0311123].
	%%CITATION = JHEPA,0407,036;%%

	%\cite{AguilarSaavedra:2005pw}
	\bibitem{AguilarSaavedra:2005pw}
	J.~A.~Aguilar-Saavedra, A.~Ali, B.~C.~Allanach, R.~L.~Arnowitt, H.~A.~Baer, J.~A.~Bagger, C.~Balazs and V.~D.~Barger {\it et al.},
	{\em Supersymmetry parameter analysis: SPA convention and project},
	Eur.\ Phys.\ J.\ C {\bf 46}, 43 (2006)
	[hep-ph/0511344].
	%%CITATION = HEP-PH/0511344;%%

	%\cite{Allanach:2008qq}
	\bibitem{Allanach:2008qq}
	B.~C.~Allanach, C.~Balazs, G.~Belanger, M.~Bernhardt, F.~Boudjema, D.~Choudhury, K.~Desch and U.~Ellwanger {\it et al.},
	%``SUSY Les Houches Accord 2,''
	Comput.\ Phys.\ Commun.\ {\bf 180}, 8 (2009)
	[arXiv:0801.0045 [hep-ph]].
	%%CITATION = ARXIV:0801.0045;%%

	\bibitem{LHEF}
	J.~Alwall {\it et al.},
	{\em A standard format for Les Houches event files},
	Comput.\ Phys.\ Commun.\ {\bf 176}, 300 (2007)
	[arXiv:hep-ph/0609017].
	%%CITATION = CPHCB,176,300;%%

	\bibitem{Hagiwara:2005wg}
	K.~Hagiwara {\it et al.},
	{\em Supersymmetry simulations with off-shell effects for LHC and
	ILC},
	Phys.\ Rev.\ D {\bf 73}, 055005 (2006)
	[arXiv:hep-ph/0512260].
	%%CITATION = PHRVA,D73,055005;%%

	\bibitem{Allanach:2002nj}
	B.~C.~Allanach {\it et al.},
	{\em The Snowmass points and slopes: Benchmarks for SUSY searches},
	in {\it Proc. of the APS/DPF/DPB Summer Study on the Future of Particle Physics (Snowmass 2001) } ed. N.~Graf,
	Eur.\ Phys.\ J.\ C {\bf 25} (2002) 113
	[eConf {\bf C010630} (2001) P125]
	[arXiv:hep-ph/0202233].
	%%CITATION = HEP-PH 0202233;%%

	\bibitem{PeskinSchroeder}
	M.E. Peskin, D.V.Schroeder, {\em An Introduction to Quantum Field
	Theory}, Addison-Wesley Publishing Co., 1995.

	\bibitem{UtaKlein}
	U. Klein, O. Fischer, {\em private communications}.

	\bibitem{stdhep}
	L.~Garren, {\em StdHep, Monte Carlo Standardization at FNAL},
	Fermilab CS-doc-903,
	\url{http://cd-docdb.fnal.gov/cgi-bin/ShowDocument?docid=903}

	%\cite{Frixione:1998jh}
	\bibitem{Frixione:1998jh}
	S.~Frixione,
	%``Isolated photons in perturbative QCD,''
	Phys.\ Lett.\ B {\bf 429}, 369 (1998)
	doi:10.1016/S0370-2693(98)00454-7
	[hep-ph/9801442].
	%%CITATION = doi:10.1016/S0370-2693(98)00454-7;%%

	\bibitem{LHAPDF}
	W.~Giele {\it et al.},
	{\em The QCD / SM working group: Summary report},
	arXiv:hep-ph/0204316;
	%%CITATION = HEP-PH/0204316;%%
	M.~R.~Whalley, D.~Bourilkov and R.~C.~Group,
	{\em The Les Houches Accord PDFs (LHAPDF) and Lhaglue},
	arXiv:hep-ph/0508110;
	%%CITATION = HEP-PH/0508110;%%
	D.~Bourilkov, R.~C.~Group and M.~R.~Whalley,
	{\em LHAPDF: PDF use from the Tevatron to the LHC},
	arXiv:hep-ph/0605240.
	%%CITATION = HEP-PH/0605240;%%

	\bibitem{HepMC}
	M.~Dobbs and J.~B.~Hansen,
	{\em The HepMC C++ Monte Carlo event record for High Energy
	Physics},
	Comput.\ Phys.\ Commun.\ {\bf 134}, 41 (2001).
	%%CITATION = CPHCB,134,41;%%

	%\cite{Boos:2004kh}
	\bibitem{Boos:2004kh}
	E.~Boos {\it et al.} [CompHEP Collaboration],
	%``CompHEP 4.4: Automatic computations from Lagrangians to events,''
	Nucl.\ Instrum.\ Meth.\ A {\bf 534}, 250 (2004)
	[hep-ph/0403113].
	%%CITATION = HEP-PH/0403113;%%
	%493 citations counted in INSPIRE as of 12 May 2014

	% Parton distributions
	%\cite{Pumplin:2002vw}
	\bibitem{Pumplin:2002vw}
	J.~Pumplin, D.~R.~Stump, J.~Huston {\it et al.},
	{\em New generation of parton distributions with uncertainties from
	global QCD analysis},
	JHEP {\bf 0207}, 012 (2002).
	[hep-ph/0201195].
	%\cite{Martin:2004dh}
	\bibitem{Martin:2004dh}
	A.~D.~Martin, R.~G.~Roberts, W.~J.~Stirling {\it et al.},
	{\em Parton distributions incorporating QED contributions},
	Eur.\ Phys.\ J.\ {\bf C39}, 155-161 (2005).
	[hep-ph/0411040].
	%\cite{Martin:2009iq}
	\bibitem{Martin:2009iq}
	A.~D.~Martin, W.~J.~Stirling, R.~S.~Thorne {\it et al.},
	{\em Parton distributions for the LHC},
	Eur.\ Phys.\ J.\ {\bf C63}, 189-285 (2009).
	[arXiv:0901.0002 [hep-ph]].
	%\cite{Lai:2010vv}
	\bibitem{Lai:2010vv}
	H.~L.~Lai, M.~Guzzi, J.~Huston, Z.~Li, P.~M.~Nadolsky, J.~Pumplin and C.~P.~Yuan,
	{\em New parton distributions for collider physics},
	Phys.\ Rev.\ D {\bf 82}, 074024 (2010)
	[arXiv:1007.2241 [hep-ph]].
	%%CITATION = PHRVA,D82,074024;%%
	%\cite{Owens:2012bv}
	\bibitem{Owens:2012bv}
	J.~F.~Owens, A.~Accardi and W.~Melnitchouk,
	{\em Global parton distributions with nuclear and finite-$Q^2$
	corrections},
	Phys.\ Rev.\ D {\bf 87}, no. 9, 094012 (2013)
	[arXiv:1212.1702 [hep-ph]].
	%%CITATION = ARXIV:1212.1702;%%
	%\cite{Accardi:2016qay}
	\bibitem{Accardi:2016qay}
	A.~Accardi, L.~T.~Brady, W.~Melnitchouk, J.~F.~Owens and N.~Sato,
	%``Constraints on large-$x$ parton distributions from new weak boson production and deep-inelastic scattering data,''
	arXiv:1602.03154 [hep-ph].
	%%CITATION = ARXIV:1602.03154;%%
	%\cite{Harland-Lang:2014zoa}
	\bibitem{Harland-Lang:2014zoa}
	L.~A.~Harland-Lang, A.~D.~Martin, P.~Motylinski and R.~S.~Thorne,
	%``Parton distributions in the LHC era: MMHT 2014 PDFs,''
	arXiv:1412.3989 [hep-ph].
	%%CITATION = ARXIV:1412.3989;%%
	%\cite{Dulat:2015mca}
	\bibitem{Dulat:2015mca}
	S.~Dulat {\it et al.},
	%``The CT14 Global Analysis of Quantum Chromodynamics,''
	arXiv:1506.07443 [hep-ph].
	%%CITATION = ARXIV:1506.07443;%%


	%\cite{Salam:2008qg}
	\bibitem{Salam:2008qg}
	G.~P.~Salam and J.~Rojo,
	{\em A Higher Order Perturbative Parton Evolution Toolkit (HOPPET)},
	Comput.\ Phys.\ Commun.\ {\bf 180}, 120 (2009)
	[arXiv:0804.3755 [hep-ph]].
	%%CITATION = ARXIV:0804.3755;%%

	%\cite{Kilian:2011ka}
	\bibitem{Kilian:2011ka}
	W.~Kilian, J.~Reuter, S.~Schmidt and D.~Wiesler,
	{\em An Analytic Initial-State Parton Shower},
	JHEP {\bf 1204} (2012) 013
	[arXiv:1112.1039 [hep-ph]].
	%%CITATION = ARXIV:1112.1039;%%

	%\cite{Staub:2008uz}
	\bibitem{Staub:2008uz}
	F.~Staub,
	{\em Sarah},
	arXiv:0806.0538 [hep-ph].
	%%CITATION = ARXIV:0806.0538;%%

	%\cite{Staub:2009bi}
	\bibitem{Staub:2009bi}
	F.~Staub,
	{\em From Superpotential to Model Files for FeynArts and
	CalcHep/CompHep},
	Comput.\ Phys.\ Commun.\ {\bf 181}, 1077 (2010)
	[arXiv:0909.2863 [hep-ph]].
	%%CITATION = ARXIV:0909.2863;%%

	%\cite{Staub:2010jh}
	\bibitem{Staub:2010jh}
	F.~Staub,
	{\em Automatic Calculation of supersymmetric Renormalization Group
	Equations and Self Energies},
	Comput.\ Phys.\ Commun.\ {\bf 182}, 808 (2011)
	[arXiv:1002.0840 [hep-ph]].
	%%CITATION = ARXIV:1002.0840;%%

	%\cite{Staub:2012pb}
	\bibitem{Staub:2012pb}
	F.~Staub,
	{\em SARAH 3.2: Dirac Gauginos, UFO output, and more},
	Computer Physics Communications {\bf 184}, pp. 1792 (2013)
	[Comput.\ Phys.\ Commun.\ {\bf 184}, 1792 (2013)]
	[arXiv:1207.0906 [hep-ph]].
	%%CITATION = ARXIV:1207.0906;%%

	%\cite{Staub:2013tta}
	\bibitem{Staub:2013tta}
	F.~Staub,
	{\em SARAH 4: A tool for (not only SUSY) model builders},
	Comput.\ Phys.\ Commun.\ {\bf 185}, 1773 (2014)
	[arXiv:1309.7223 [hep-ph]].
	%%CITATION = ARXIV:1309.7223;%%

	\bibitem{mathematica}
	\Mathematica\ is a registered trademark of Wolfram Research, Inc.,
	Champain, IL, USA.

	%\cite{Porod:2003um}
	\bibitem{Porod:2003um}
	W.~Porod,
	{\em SPheno, a program for calculating supersymmetric spectra, SUSY
	particle decays and SUSY particle production at e+ e- colliders},
	Comput.\ Phys.\ Commun.\ {\bf 153}, 275 (2003)
	[hep-ph/0301101].
	%%CITATION = HEP-PH/0301101;%%

	%\cite{Porod:2011nf}
	\bibitem{Porod:2011nf}
	W.~Porod and F.~Staub,
	{\em SPheno 3.1: Extensions including flavour, CP-phases and models
	beyond the MSSM},
	Comput.\ Phys.\ Commun.\ {\bf 183}, 2458 (2012)
	[arXiv:1104.1573 [hep-ph]].
	%%CITATION = ARXIV:1104.1573;%%

	%\cite{Staub:2011dp}
	\bibitem{Staub:2011dp}
	F.~Staub, T.~Ohl, W.~Porod and C.~Speckner,
	%``A Tool Box for Implementing Supersymmetric Models,''
	Comput.\ Phys.\ Commun.\ {\bf 183}, 2165 (2012)
	[arXiv:1109.5147 [hep-ph]].
	%%CITATION = ARXIV:1109.5147;%%

	%%%%% FeynRules %%%%%

	%\cite{Christensen:2008py}
	\bibitem{Christensen:2008py}
	N.~D.~Christensen and C.~Duhr,
	{\em FeynRules - Feynman rules made easy},
	Comput.\ Phys.\ Commun.\ {\bf 180}, 1614 (2009)
	[arXiv:0806.4194 [hep-ph]].
	%%CITATION = ARXIV:0806.4194;%%

	%\cite{Christensen:2009jx}
	\bibitem{Christensen:2009jx}
	N.~D.~Christensen, P.~de Aquino, C.~Degrande, C.~Duhr, B.~Fuks,
	M.~Herquet, F.~Maltoni and S.~Schumann,
	{\em A Comprehensive approach to new physics simulations},
	Eur.\ Phys.\ J.\ C {\bf 71}, 1541 (2011)
	[arXiv:0906.2474 [hep-ph]].
	%%CITATION = ARXIV:0906.2474;%%

	%\cite{Duhr:2011se}
	\bibitem{Duhr:2011se}
	C.~Duhr and B.~Fuks,
	%``A superspace module for the FeynRules package,''
	Comput.\ Phys.\ Commun.\ {\bf 182}, 2404 (2011)
	[arXiv:1102.4191 [hep-ph]].
	%%CITATION = ARXIV:1102.4191;%%

	%\cite{Christensen:2010wz}
	\bibitem{Christensen:2010wz}
	N.~D.~Christensen, C.~Duhr, B.~Fuks, J.~Reuter and C.~Speckner,
	{\em Introducing an interface between WHIZARD and FeynRules},
	Eur.\ Phys.\ J.\ C {\bf 72}, 1990 (2012)
	[arXiv:1010.3251 [hep-ph]].
	%%CITATION = ARXIV:1010.3251;%%

	%\cite{Degrande:2011ua}
	\bibitem{Degrande:2011ua}
	C.~Degrande, C.~Duhr, B.~Fuks, D.~Grellscheid, O.~Mattelaer and T.~Reiter,
	%``UFO - The Universal FeynRules Output,''
	Comput.\ Phys.\ Commun.\ {\bf 183}, 1201 (2012)
	doi:10.1016/j.cpc.2012.01.022
	[arXiv:1108.2040 [hep-ph]].
	%%CITATION = doi:10.1016/j.cpc.2012.01.022;%%

	%\cite{Han:1998sg}
	\bibitem{Han:1998sg}
	T.~Han, J.~D.~Lykken and R.~-J.~Zhang,
	{\em On Kaluza-Klein states from large extra dimensions},
	Phys.\ Rev.\ D {\bf 59}, 105006 (1999)
	[hep-ph/9811350].
	%%CITATION = HEP-PH/9811350;%%

	%\cite{Fuks:2012im}
	\bibitem{Fuks:2012im}
	B.~Fuks,
	{\em Beyond the Minimal Supersymmetric Standard Model: from theory
	to phenomenology},
	Int.\ J.\ Mod.\ Phys.\ A {\bf 27}, 1230007 (2012)
	[arXiv:1202.4769 [hep-ph]].
	%%CITATION = ARXIV:1202.4769;%%

	%\cite{He:2007ge}
	\bibitem{He:2007ge}
	H.~-J.~He, Y.~-P.~Kuang, Y.~-H.~Qi, B.~Zhang, A.~Belyaev,
	R.~S.~Chivukula, N.~D.~Christensen and A.~Pukhov {\it et al.},
	{\em CERN LHC Signatures of New Gauge Bosons in Minimal Higgsless
	Model},
	Phys.\ Rev.\ D {\bf 78}, 031701 (2008)
	[arXiv:0708.2588 [hep-ph]].
	%%CITATION = ARXIV:0708.2588;%%

	%%%%% WHIZARD NLO %%%%%

	%\cite{Kilian:2006cj}
	\bibitem{Kilian:2006cj}
	W.~Kilian, J.~Reuter and T.~Robens,
	{\em NLO Event Generation for Chargino Production at the ILC},
	Eur.\ Phys.\ J.\ C {\bf 48}, 389 (2006)
	[hep-ph/0607127].
	%%CITATION = HEP-PH/0607127;%%

	%\cite{Binoth:2010ra}
	\bibitem{Binoth:2010ra}
	J.~R.~Andersen {\it et al.} [SM and NLO Multileg Working Group
	Collaboration],
	{\em Les Houches 2009: The SM and NLO Multileg Working Group:
	Summary report},
	arXiv:1003.1241 [hep-ph].
	%%CITATION = ARXIV:1003.1241;%%

	%\cite{Butterworth:2010ym}
	\bibitem{Butterworth:2010ym}
	J.~M.~Butterworth, A.~Arbey, L.~Basso, S.~Belov, A.~Bharucha,
	F.~Braam, A.~Buckley and M.~Campanelli {\it et al.},
	{\em Les Houches 2009: The Tools and Monte Carlo working group
	Summary Report},
	arXiv:1003.1643 [hep-ph], arXiv:1003.1643 [hep-ph].
	%%CITATION = ARXIV:1003.1643;%%

	%\cite{Binoth:2009rv}
	\bibitem{Binoth:2009rv}
	T.~Binoth, N.~Greiner, A.~Guffanti, J.~Reuter, J.-P.~.Guillet and T.~Reiter,
	{\em Next-to-leading order QCD corrections to pp --> b anti-b b
	anti-b + X at the LHC: the quark induced case},
	Phys.\ Lett.\ B {\bf 685}, 293 (2010)
	[arXiv:0910.4379 [hep-ph]].
	%%CITATION = ARXIV:0910.4379;%%

	%\cite{Greiner:2011mp}
	\bibitem{Greiner:2011mp}
	N.~Greiner, A.~Guffanti, T.~Reiter and J.~Reuter,
	{\em NLO QCD corrections to the production of two bottom-antibottom
	pairs at the LHC}
	Phys.\ Rev.\ Lett.\ {\bf 107}, 102002 (2011)
	[arXiv:1105.3624 [hep-ph]].
	%% CITATION = ARXIV:1105.3624;%%

	%\cite{L_Ecuyer:2002}
	\bibitem{L_Ecuyer:2002}
	P.~L\'{e}Ecuyer, R.~Simard, E.~J.~Chen, and W.~D.~Kelton,
	{\em An Object-Oriented Random-Number Package with Many Long Streams and
	Substreams},
	Operations Research, vol. 50, no. 6, pp. 1073-1075, Dec. 2002.

	%\cite{Platzer:2013esa}
	\bibitem{Platzer:2013esa}
	S.~Pl\"atzer,
	{\em RAMBO on diet},
	[arXiv:1308.2922 [hep-ph]].
	%% CITATION = ARXIV:1308.2922;%%

	%\cite{Kleiss:1991rn}
	\bibitem{Kleiss:1991rn}
	R.~Kleiss and W.~J.~Stirling,
	{\em Massive multiplicities and Monte Carlo},
	Nucl.\ Phys.\ B {\bf 385}, 413 (1992).
	doi:10.1016/0550-3213(92)90107-M
	%%CITATION = doi:10.1016/0550-3213(92)90107-M;%%

	%\cite{Kleiss:1985gy}
	\bibitem{Kleiss:1985gy}
	R.~Kleiss, W.~J.~Stirling and S.~D.~Ellis,
	{\em A New Monte Carlo Treatment of Multiparticle Phase Space at High-energies},
	Comput.\ Phys.\ Commun.\ {\bf 40} (1986) 359.
	doi:10.1016/0010-4655(86)90119-0
	%% CITATION = doi:10.1016/0010-4655(86)90119-0;%%

	%\cite{Brun:1997pa}
	\bibitem{Brun:1997pa}
	R.~Brun and F.~Rademakers,
	{\em ROOT: An object oriented data analysis framework},
	Nucl. Instrum. Meth. A \textbf{389}, 81-86 (1997)
	doi:10.1016/S0168-9002(97)00048-X

	%\cite{Buckley:2010ar}
	\bibitem{Buckley:2010ar}
	A.~Buckley, J.~Butterworth, L.~L\"onnblad, D.~Grellscheid, H.~Hoeth, J.~Monk, H.~Schulz and F.~Siegert,
	{\em Rivet user manual},
	Comput. Phys. Commun. \textbf{184}, 2803-2819 (2013)
	doi:10.1016/j.cpc.2013.05.021
	[arXiv:1003.0694 [hep-ph]].

	%\cite{Bierlich:2019rhm}
	\bibitem{Bierlich:2019rhm}
	C.~Bierlich, A.~Buckley, J.~Butterworth, C.~H.~Christensen, L.~Corpe,
	D.~Grellscheid, J.~F.~Grosse-Oetringhaus, C.~Gutschow,
	P.~Karczmarczyk, J.~Klein, L.~L\"onnblad, C.~S.~Pollard, P.~Richardson,
	H.~Schulz and F.~Siegert,
	{\em Robust Independent Validation of Experiment and Theory: Rivet
	version 3},
	SciPost Phys. \textbf{8}, 026 (2020)
	doi:10.21468/SciPostPhys.8.2.026
	[arXiv:1912.05451 [hep-ph]].

	%\cite{deFavereau:2013fsa}
	\bibitem{deFavereau:2013fsa}
	J.~de Favereau \textit{et al.} [DELPHES 3],
	{\em DELPHES 3, A modular framework for fast simulation of a generic
	collider experiment},
	JHEP \textbf{02}, 057 (2014)
	doi:10.1007/JHEP02(2014)057
	[arXiv:1307.6346 [hep-ex]]

	\end{thebibliography}

	\end{document}
	Index: trunk/ChangeLog
	===================================================================
	--- trunk/ChangeLog (revision 8903)
	+++ trunk/ChangeLog (revision 8904)
	@@ -1,2418 +1,2421 @@
	ChangeLog -- Summary of changes to the WHIZARD package

	Use git log/svn log to see detailed changes.

	Version 3.1.3.1

	+2023-10-20
	+ Infrastructure for NLO hadron collisions with GoSam
	+
	##################################################################

	2023-10-06
	RELEASE: version 3.1.3

	2023-10-02
	CIRCE2: add 'null' maps for regions with not enough statistics
	O'Mega/CIRCE2: remove pre OCaml 4.08 workarounds

	2023-09-25
	Minimal compiler versions: OCaml 4.08, gfortran 9.1.0

	2023-09-22
	Bug fix UFO interface: parsing of tokens corrected

	2023-06-01
	Common folder 'contrib' for external codes shipped with WHIZARD

	2023-05-28
	Bug fix UFO interface: workaround for case-sensitive parameters

	2023-05-05
	Update of meson and baryon listings in SM hadrons model

	2023-03-28
	Workaround for Intel oneAPI 2022/23 regression(s)

	##################################################################

	2023-03-21
	RELEASE: version 3.1.2

	2023-03-21
	Bug fix in cyclic build dependence of WHIZARD core

	2023-03-11
	Resolve minor inconsistency in manual for NLO real partition

	##################################################################

	2023-03-10
	RELEASE: version 3.1.1

	2023-03-09
	Bug fix in UFO file parser
	Small bug fix in NLO EW infrastructure

	2023-03-01
	Bug fix: numerical mapping stability for peaked PDFs

	2023-02-28
	Bug fix UFO interface: avoid too long ME code lines

	2023-02-22
	Infrastructure for calculation of kinematic MT2 variable

	2023-02-17
	Bug fix UFO interface: correct parentheses in rational functions

	##################################################################

	2022-12-14
	RELEASE: version 3.1.0

	2022-12-12
	Bug fix Pythia8 interface: production vertices, shower history
	O'Mega support for epsilon tensor color structures

	2023-01-27
	Support for loop-induced processes

	2022-11-30
	O'Mega support for general SU(N) color representations

	2022-11-07
	Modernize configure checks for Python versions v3.10+

	2022-10-21
	General POWHEG matching
	with optional NLO real phase space partitioning

	2022-09-26
	Bug fix: accept negative scale values in SLHA block header

	2022-08-08
	Numerical stability of testsuite for Apple M1 processors

	2022-08-07
	Technically allow for muons as CIRCE2 beam spectra

	2022-06-22
	POWHEG matching for Drell-Yan and similar processes

	2022-06-12
	Add unit tests for Lorentz and phase-space modules

	2022-05-09
	Massive eikonals: Numeric robustness at ultrahigh energies

	2022-04-20
	Bug fix for VAMP2 event generation with indefinite samples

	##################################################################

	2022-04-06
	RELEASE: version 3.0.3

	2022-04-05
	POWHEG matching for single flavor hadron collisions

	2022-03-31
	NLO EW processes with massless leptons and jets (i.e.
	jet clustering and photon recombination) supported
	NLO EW for massive initial leptons validated

	2022-03-27
	Complete implementation/validation of NLL electron PDFs

	2022-02-22
	Bug fix: correct normalization for CIRCE2+EPA+polarization

	2022-02-21
	WHIZARD core now uses Fortran modules and submodules

	2022-01-27
	Infrastructure for POWHEG matching for hadron collisions

	2021-12-16
	Event files can be written/read also for decay processes
	Implementation of running QED coupling alpha

	2021-12-10
	Independent variations of renormalization/factorization scale

	##################################################################

	2021-11-23
	RELEASE: version 3.0.2

	2021-11-19
	Support for a wide class of mixed NLO QCD/EW processes

	2021-11-18
	Add pp processes for NLO EW corrections to testsuite

	2021-11-11
	Output numerically critical values with LCIO 2.17+ as double

	2021-11-05
	Minor refactoring on phase space points and kinematics

	2021-10-21
	NLO (QCD) differential distributions supported for full
	lepton collider setup: polarization, QED ISR, beamstrahlung

	2021-10-15
	SINDARIN now has a sum and product function of expressions,
	SINDARIN supports observables defined on full (sub)events
	First application: transverse mass
	Bug fix: 2HDM did not allow H+, H- as external particles

	2021-10-14
	CT18 PDFs included (NLO, NNLO)

	2021-09-30
	Bug fix: keep non-recombined photons in the event record

	2021-09-13
	Modular NLO event generation with real partition

	2021-08-20
	Bug fix: correctly reading in NLO fixed order events

	2021-08-06
	Generalize optional partitioning of the NLO real phase space

	##################################################################

	2021-07-08
	RELEASE: version 3.0.1

	2021-07-06
	MPI parallelization now comes with two incarnations:
	- standard MPI parallelization ("simple", default)
	- MPI with load balancer ("load")

	2021-07-05
	Bug fix for C++17 default compilers w/ HepMC3/ROOT interface

	2021-07-02
	Improvement for POWHEG matching:
	- implement massless recoil case
	- enable reading in existing POWHEG grids
	- support kinematic cuts at generator level

	2021-07-01
	Distinguish different cases of photons in NLO EW corrections

	2021-06-21
	Option to keep negative PDF entries or set them zero

	2021-05-31
	Full LCIO MC production files can be properly recasted

	2021-05-24
	Use defaults for UFO models without propagators.py

	2021-05-21
	Bug fix: prevent invalid code for UFO models containing hyphens

	2021-05-20
	UFO files with scientific notation float constants allowed
	UFO files: max. n-arity of vertices bound by process multiplicity

	##################################################################

	2021-04-27
	RELEASE: version 3.0.0

	2021-04-20
	Minimal required OCaml version is now 4.05.0.
	Bug fix for tau polarization from stau decays

	2021-04-19
	NLO EW splitting functions and collinear remnants completed
	Photon recombination implemented

	2021-04-14
	Bug fix for vertices/status codes with HepMC2/3 event format

	2021-04-08
	Correct Lorentz statistics for UFO model with Majorana fermions

	2021-04-06
	Bug fix for rare script failure in system_dependencies.f90.in
	Kappa factor for quartic Higgs coupling in SM_ac(_CKM) model

	2021-04-04
	Support for UFO extensions in SMEFTSim 3.0

	2021-02-25
	Enable VAMP and VAMP2 channel equivalences for NLO integrations

	2021-02-04
	Bug fix if user does not set a prefix at configuration

	2020-12-10
	Generalize NLO calculations to non-CMS lab frames

	2020-12-08
	Bug fix in expanded p-wave form factor for top threshold

	2020-12-06
	Patch for macOS Big Sur shared library handling due to libtool;
	the patch also demands gcc/gfortran 11.0/10.3/9.4/8.5

	2020-12-04
	O'Mega only inserts non-vanishing couplings from UFO models

	2020-11-21
	Bug fix for fractional hypercharges in UFO models

	2020-11-11
	Enable PYTHIA6 settings for eh collisions (enable-pythia6_eh)

	2020-11-09
	Correct flavor assignment for NLO fixed-order events

	2020-11-05
	Bug fix for ISR handler not working with unstable particles

	2020-10-08
	Bug fix in LHAPDF interface for photon PDFs

	2020-10-07
	Bug fix for structure function setup with asymmetric beams

	2020-10-02
	Python/Cython layer for WHIZARD API

	2020-09-30
	Allow mismatches of Python and name attributes in UFO models

	2020-09-26
	Support for negative PDG particles from certain UFO models

	2020-09-24
	Allow for QNUMBERS blocks in BSM SLHA files

	2020-09-22
	Full support for compilation with clang(++) on Darwin/macOS
	More documentation in the manual
	Minor clean-ups

	2020-09-16
	Bug fix enables reading LCIO events with LCIO v2.15+

	##################################################################

	2020-09-16
	RELEASE: version 2.8.5

	2020-09-11
	Bug fix for H->tau tau transverse polarization with PYTHIA6
	(thanks to Junping Tian / Akiya Miyamoto)

	2020-09-09
	Fix a long standing bug (since 2.0) in the calculation of color
	factors when particles of different color were combined in a
	particle class. NB: O'Mega never produced a wrong number,
	it only declared all processes as invalid.

	2020-09-08
	Enable Openloops matrix element equivalences for optimization

	2020-09-02
	Compatibility fix for PYTHIA v8.301+ interface

	2020-09-01
	Support exclusive jet clustering in ee for Fastjet interface

	##################################################################

	2020-08-30
	RELEASE: version 3.0.0_beta

	2020-08-27
	Major revision of NLO distributions and events for
	processes with structure functions:
	- Use parton momenta/flavors (instead of beams) for events
	- Bug fix for Lorentz boosts and Lorentz frames of momenta
	- Bug fix: apply cuts to virtual NLO component in correct frame
	- Correctly assign ISR radiation momenta in data structures
	- Refactoring on quantum numbers for NLO event data structures
	- Functional tests for hadron collider NLO distributions
	- many minor bug fixes regarding NLO hadron collider physics

	2020-08-11
	Bug fix for linking problem with OpenMPI

	2020-08-07
	New WHIZARD API: WHIZARD can be externally linked as a
	library, added examples for Fortran, C, C++ programs

	##################################################################

	2020-07-08
	RELEASE: version 2.8.4

	2020-07-07
	Bug fix: steering of UFO Majorana models from WHIZARD

	##################################################################

	2020-07-06
	Combined integration also for hadron collider processes at NLO

	2020-07-05
	Bug fix: correctly steer e+e- FastJet clustering algorithms
	Major revision of NLO differential distributions and events:
	- Correctly assign quantum numbers to NLO fixed-order events
	- Correctly assign weights to NLO fixed-order events for
	combined simulation
	- Cut all NLO fixed-order subevents in event groups individually
	- Only allow "sigma" normalization for NLO fixed-order events
	- Use correct PDF setup for NLO counter events
	- Several technical fixes and updates of the NLO testsuite

	##################################################################

	2020-07-03
	RELEASE: version 2.8.3

	2020-07-02
	Feature-complete UFO implementation for Majorana fermions

	2020-06-22
	Running width scheme supported for O'Mega matrix elements

	2020-06-20
	Adding H-s-s coupling to SM_Higgs(_CKM) models

	2020-06-17
	Completion of ILC 2->6 fermion extended test suite

	2020-06-15
	Bug fix: PYTHIA6/Tauola, correctly assign tau spins for stau decays

	2020-06-09
	Bug fix: correctly update calls for additional VAMP/2 iterations
	Bug fix: correct assignment for tau spins from PYTHIA6 interface

	2020-06-04
	Bug fix: cascades2 tree merge with empty subtree(s)

	2020-05-31
	Switch $epa_mode for different EPA implementations

	2020-05-26
	Bug fix: spin information transferred for resonance histories

	2020-04-13
	HepMC: correct weighted events for non-xsec event normalizations

	2020-04-04
	Improved HepMC3 interface: HepMC3 Root/RootTree interface

	2020-03-24
	ISR: Fix on-shell kinematics for events with ?isr_handler=true
	(set ?isr_handler_keep_mass=false for old behavior)

	2020-03-11
	Beam masses are correctly passed to hard matrix element for CIRCE2
	EPA with polarized beams: double-counting corrected

	##################################################################

	2020-03-03
	RELEASE: version 3.0.0_alpha

	2020-02-25
	Bug fix: Scale and alphas can be retrieved from internal event format to
	external formats

	2020-02-17
	Bug fix: ?keep_failed_events now forces output of actual event data
	Bug fix: particle-set reconstruction (rescanning events w/o radiation)

	2020-01-28
	Bug fix for left-over EPA parameter epa_e_max (replaced by epa_q_max)

	2020-01-23
	Bug fix for real components of NLO QCD 2->1 processes

	2020-01-22
	Bug fix: correct random number sequencing during parallel MPI event
	generation with rng_stream

	2020-01-21
	Consistent distribution of events during parallel MPI event generation

	2020-01-20
	Bug fix for configure setup for automake v1.16+

	2020-01-18
	General SLHA parameter files for UFO models supported

	2020-01-08
	Bug fix: correctly register RECOLA processes with flavor sums

	2019-12-19
	Support for UFO customized propagators
	O'Mega unit tests for fermion-number violating interactions

	2019-12-10
	For distribution building: check for graphviz/dot
	version 2.40 or newer

	2019-11-21
	Bug fix: alternate setups now work correctly
	Infrastructure for accessing alpha_QED event-by-event
	Guard against tiny numbers that break ASCII event output
	Enable inverse hyperbolic functions as SINDARIN observables
	Remove old compiler bug workarounds

	2019-11-20
	Allow quoted -e argument, implemented -f option

	2019-11-19
	Bug fix: resonance histories now work also with UFO models
	Fix in numerical precision of ASCII VAMP2 grids

	2019-11-06
	Add squared matrix elements to the LCIO event header

	2019-11-05
	Do not include RNG state in MD5 sum for CIRCE1/2

	2019-11-04
	Full CIRCE2 ILC 250 and 500 GeV beam spectra added
	Minor update on LCIO event header information

	2019-10-30
	NLO QCD for final states completed
	When using Openloops, v2.1.1+ mandatory

	2019-10-25
	Binary grid files for VAMP2 integrator

	##################################################################

	2019-10-24
	RELEASE: version 2.8.2

	2019-10-20
	Bug fix for HepMC linker flags

	2019-10-19
	Support for spin-2 particles from UFO files

	2019-09-27
	LCIO event format allows rescan and alternate weights

	2019-09-24
	Compatibility fix for OCaml v4.08.0+

	##################################################################

	2019-09-21
	RELEASE: version 2.8.1

	2019-09-19
	Carriage return characters in UFO models can be parsed
	Mathematica symbols in UFO models possible
	Unused/undefined parameters in UFO models handled

	2019-09-13
	New extended NLO test suite for ee and pp processes

	2019-09-09
	Photon isolation (separation of perturbative and fragmentation
	part a la Frixione)

	2019-09-05
	Major progress on NLO QCD for hadron collisions:
	- correctly assign flavor structures for alpha regions
	- fix crossing of particles for initial state splittings
	- correct assignment for PDF factors for real subtractions
	- fix kinematics for collinear splittings
	- bug fix for integrated virtual subtraction terms

	2019-09-03
	b and c jet selection in cuts and analysis

	2019-08-27
	Support for Intel MPI

	2019-08-20
	Complete (preliminary) HepMC3 support (incl.
	backwards HepMC2 write/read mode)

	2019-08-08
	Bug fix: handle carriage returns in UFO files (non-Unix OS)

	##################################################################

	2019-08-07
	RELEASE: version 2.8.0

	2019-07-31
	Complete WHIZARD UFO interface:
	- general Lorentz structures
	- matrix element support for general color factors
	- missing features: Majorana fermions and SLHA

	2019-07-20
	Make WHIZARD compatible with OCaml 4.08.0+

	2019-07-19
	Fix version testing for LHAPDF 6.2.3 and newer
	Minimal required OCaml version is now 4.02.3.

	2019-04-18
	Correctly generate ordered FKS tuples for alpha regions
	from all possible underlying Born processes

	2019-04-08
	Extended O'Mega/Recola matrix element test suite

	2019-03-29
	Correct identical particle symmetry factors for FKS subtraction

	2019-03-28
	Correct assertion of spin-correlated matrix
	elements for hadron collisions

	2019-03-27
	Bug fix for cut-off parameter delta_i for
	collinear plus/minus regions

	##################################################################

	2019-03-27
	RELEASE: version 2.7.1

	2019-02-19
	Further infrastructure for HepMC3 interface (v3.01.00)

	2019-02-07
	Explicit configure option for using debugging options
	Bug fix for performance by removing unnecessary debug operations

	2019-01-29
	Bug fix for DGLAP remnants with cut-off parameter delta_i

	2019-01-24
	Radiative decay neu2 -> neu1 A added to MSSM_Hgg model

	##################################################################

	2019-01-21
	RELEASE: version 2.7.0

	2018-12-18
	Support RECOLA for integrated und unintegrated subtractions

	2018-12-11
	FCNC top-up sector in model SM_top_anom

	2018-12-05
	Use libtirpc instead of SunRPC on Arch Linux etc.

	2018-11-30
	Display rescaling factor for weighted event samples with cuts

	2018-11-29
	Reintroduce check against different masses in flavor sums
	Bug fix for wrong couplings in the Littlest Higgs model(s)

	2018-11-22
	Bug fix for rescanning events with beam structure

	2018-11-09
	Major refactoring of internal process data

	2018-11-02
	PYTHIA8 interface

	2018-10-29
	Flat phase space parametrization with RAMBO (on diet) implemented

	2018-10-17
	Revise extended test suite

	2018-09-27
	Process container for RECOLA processes

	2018-09-15
	Fixes by M. Berggren for PYTHIA6 interface

	2018-09-14
	First fixes after HepForge modernization

	##################################################################

	2018-08-23
	RELEASE: version 2.6.4

	2018-08-09
	Infrastructure to check colored subevents

	2018-07-10
	Infrastructure for running WHIZARD in batch mode

	2018-07-04
	MPI available from distribution tarball

	2018-06-03
	Support Intel Fortran Compiler under MAC OS X

	2018-05-07
	FKS slicing parameter delta_i (initial state) implementend

	2018-05-03
	Refactor structure function assignment for NLO

	2018-05-02
	FKS slicing parameter xi_cut, delta_0 implemented

	2018-04-20
	Workspace subdirectory for process integration (grid/phs files)
	Packing/unpacking of files at job end/start
	Exporting integration results from scan loops

	2018-04-13
	Extended QCD NLO test suite

	2018-04-09
	Bug fix for Higgs Singlet Extension model

	2018-04-06
	Workspace subdirectory for process generation and compilation
	--job-id option for creating job-specific names

	2018-03-20
	Bug fix for color flow matching in hadron collisions
	with identical initial state quarks

	2018-03-08
	Structure functions quantum numbers correctly assigned for NLO

	2018-02-24
	Configure setup includes 'pgfortran' and 'flang'

	2018-02-21
	Include spin-correlated matrix elements in interactions

	2018-02-15
	Separate module for QED ISR structure functions

	##################################################################

	2018-02-10
	RELEASE: version 2.6.3

	2018-02-08
	Improvements in memory management for PS generation

	2018-01-31
	Partial refactoring: quantum number assigment NLO
	Initial-state QCD splittings for hadron collisions

	2018-01-25
	Bug fix for weighted events with VAMP2

	2018-01-17
	Generalized interface for Recola versions 1.3+ and 2.1+

	2018-01-15
	Channel equivalences also for VAMP2 integrator

	2018-01-12
	Fix for OCaml compiler 4.06 (and newer)

	2017-12-19
	RECOLA matrix elements with flavor sums can be integrated

	2017-12-18
	Bug fix for segmentation fault in empty resonance histories

	2017-12-16
	Fixing a bug in PYTHIA6 PYHEPC routine by omitting CMShowers
	from transferral between PYTHIA and WHIZARD event records

	2017-12-15
	Event index for multiple processes in event file correct

	##################################################################

	2017-12-13
	RELEASE: version 2.6.2

	2017-12-07
	User can set offset in event numbers

	2017-11-29
	Possibility to have more than one RECOLA process in one file

	2017-11-23
	Transversal/mixed (and unitarized) dim-8 operators

	2017-11-16
	epa_q_max replaces epa_e_max (trivial factor 2)

	2017-11-15
	O'Mega matrix element compilation silent now

	2017-11-14
	Complete expanded P-wave form factor for top threshold

	2017-11-10
	Incoming particles can be accessed in SINDARIN

	2017-11-08
	Improved handling of resonance insertion, additional parameters

	2017-11-04
	Added Higgs-electron coupling (SM_Higgs)

	##################################################################

	2017-11-03
	RELEASE: version 2.6.1

	2017-10-20
	More than 5 NLO components possible at same time

	2017-10-19
	Gaussian cutoff for shower resonance matching

	2017-10-12
	Alternative (more efficient) method to generate
	phase space file

	2017-10-11
	Bug fix for shower resonance histories for processes
	with multiple components

	2017-09-25
	Bug fix for process libraries in shower resonance histories

	2017-09-21
	Correctly generate pT distribution for EPA remnants

	2017-09-20
	Set branching ratios for unstable particles also by hand

	2017-09-14
	Correctly generate pT distribution for ISR photons

	##################################################################

	2017-09-08
	RELEASE: version 2.6.0

	2017-09-05
	Bug fix for initial state NLO QCD flavor structures
	Real and virtual NLO QCD hadron collider processes
	work with internal interactions

	2017-09-04
	Fully validated MPI integration and event generation

	2017-09-01
	Resonance histories for shower: full support
	Bug fix in O'Mega model constraints
	O'Mega allows to output a parsable form of the DAG

	2017-08-24
	Resonance histories in events for transferral
	to parton shower (e.g. in ee -> jjjj)

	2017-08-01
	Alpha version of HepMC v3 interface
	(not yet really functional)

	2017-07-31
	Beta version for RECOLA OLP support

	2017-07-06
	Radiation generator fix for LHC processes

	2017-06-30
	Fix bug for NLO with structure
	functions and/or polarization

	2017-06-23
	Collinear limit for QED corrections works

	2017-06-17
	POWHEG grids generated already during integration

	2017-06-12
	Soft limit for QED corrections works

	2017-05-16
	Beta version of full MPI parallelization (VAMP2)
	Check consistency of POWHEG grid files
	Logfile config-summary.log for configure summary

	2017-05-12
	Allow polarization in top threshold

	2017-05-09
	Minimal demand automake 1.12.2
	Silent rules for make procedures

	2017-05-07
	Major fix for POWHEG damping
	Correctly initialize FKS ISR phasespace

	##################################################################

	2017-05-06
	RELEASE: version 2.5.0

	2017-05-05
	Full UFO support (SM-like models)
	Fixed-beam ISR FKS phase space

	2017-04-26
	QED splittings in radiation generator

	2017-04-10
	Retire deprecated O'Mega vertex cache files

	##################################################################

	2017-03-24
	RELEASE: version 2.4.1

	2017-03-16
	Distinguish resonance charge in phase space channels
	Keep track of resonance histories in phase space
	Complex mass scheme default for OpenLoops amplitudes

	2017-03-13
	Fix helicities for polarized OpenLoops calculations

	2017-03-09
	Possibility to advance RNG state in rng_stream

	2017-03-04
	General setup for partitioning real emission
	phase space

	2017-03-06
	Bug fix on rescan command for converting event files

	2017-02-27
	Alternative multi-channel VEGAS implementation
	VAMP2: serial backbone for MPI setup
	Smoothstep top threshold matching

	2017-02-25
	Single-beam structure function with
	s-channel mapping supported
	Safeguard against invalid process libraries

	2017-02-16
	Radiation generator for photon emission

	2017-02-10
	Fixes for NLO QCD processes (color correlations)

	2017-01-16
	LCIO variable takes precedence over LCIO_DIR

	2017-01-13
	Alternative random number generator
	rng_stream (cf. L'Ecuyer et al.)

	2017-01-01
	Fix for multi-flavor BLHA tree
	matrix elements

	2016-12-31
	Grid path option for VAMP grids

	2016-12-28
	Alpha version of Recola OLP support

	2016-12-27
	Dalitz plots for FKS phase space

	2016-12-14
	NLO multi-flavor events possible

	2016-12-09
	LCIO event header information added

	2016-12-02
	Alpha version of RECOLA interface
	Bug fix for generator status in LCIO

	##################################################################

	2016-11-28
	RELEASE: version 2.4.0

	2016-11-24
	Bug fix for OpenLoops interface: EW scheme
	is set by WHIZARD
	Bug fixes for top threshold implementation

	2016-11-11
	Refactoring of dispatching

	2016-10-18
	Bug fix for LCIO output

	2016-10-10
	First implementation for collinear soft terms

	2016-10-06
	First full WHIZARD models from UFO files

	2016-10-05
	WHIZARD does not support legacy gcc 4.7.4 any longer

	2016-09-30
	Major refactoring of process core and NLO components

	2016-09-23
	WHIZARD homogeneous entity: discarding subconfigures
	for CIRCE1/2, O'Mega, VAMP subpackages; these are
	reconstructable by script projectors

	2016-09-06
	Introduce main configure summary

	2016-08-26
	Fix memory leak in event generation

	##################################################################

	2016-08-25
	RELEASE: version 2.3.1

	2016-08-19
	Bug fix for EW-scheme dependence of gluino propagators

	2016-08-01
	Beta version of complex mass scheme support

	2016-07-26
	Fix bug in POWHEG damping for the matching

	##################################################################

	2016-07-21
	RELEASE: version 2.3.0

	2016-07-20
	UFO file support (alpha version) in O'Mega

	2016-07-13
	New (more) stable of WHIZARD GUI
	Support for EW schemes for OpenLoops
	Factorized NLO top decays for threshold model

	2016-06-15
	Passing factorization scale to PYTHIA6
	Adding charge and neutral observables

	2016-06-14
	Correcting angular distribution/tweaked kinematics in
	non-collinear structure functions splittings

	2016-05-10
	Include (Fortran) TAUOLA/PHOTOS for tau decays via PYTHIA6
	(backwards validation of LC CDR/TDR samples)

	2016-04-27
	Within OpenLoops virtuals: support for Collier library

	2016-04-25
	O'Mega vertex tables only loaded at first usage

	2016-04-21
	New CJ15 PDF parameterizations added

	2016-04-21
	Support for hadron collisions at NLO QCD

	2016-04-05
	Support for different (parameter) schemes in model files

	2016-03-31
	Correct transferral of lifetime/vertex from PYTHIA/TAUOLA
	into the event record

	2016-03-21
	New internal implementation of polarization
	via Bloch vectors, remove pointer constructions

	2016-03-13
	Extension of cascade syntax for processes:
	exclude propagators/vertices etc. possible

	2016-02-24
	Full support for OpenLoops QCD NLO matrix
	elements, inclusion in test suite

	2016-02-12
	Substantial progress on QCD NLO support

	2016-02-02
	Automated resonance mapping for FKS subtraction

	2015-12-17
	New BSM model WZW for diphoton resonances

	##################################################################

	2015-11-22
	RELEASE: version 2.2.8

	2015-11-21
	Bug fix for fixed-order NLO events

	2015-11-20
	Anomalous FCNC top-charm vertices

	2015-11-19
	StdHEP output via HEPEVT/HEPEV4 supported

	2015-11-18
	Full set of electroweak dim-6 operators included

	2015-10-22
	Polarized one-loop amplitudes supported

	2015-10-21
	Fixes for event formats for showered events

	2015-10-14
	Callback mechanism for event output

	2015-09-22
	Bypass matrix elements in pure event sample rescans
	StdHep frozen final version v5.06.01 included internally

	2015-09-21
	configure option --with-precision to
	demand 64bit, 80bit, or 128bit Fortran
	and bind C precision types

	2015-09-07
	More extensive tests of NLO
	infrastructure and POWHEG matching

	2015-09-01
	NLO decay infrastructure
	User-defined squared matrix elements
	Inclusive FastJet algorithm plugin
	Numerical improvement for small boosts

	##################################################################

	2015-08-11
	RELEASE: version 2.2.7

	2015-08-10
	Infrastructure for damped POWHEG
	Massive emitters in POWHEG
	Born matrix elements via BLHA
	GoSam filters via SINDARIN
	Minor running coupling bug fixes
	Fixed-order NLO events

	2015-08-06
	CT14 PDFs included (LO, NLO, NNLL)

	2015-07-07
	Revalidation of ILC WHIZARD-PYTHIA event chain
	Extended test suite for showered events
	Alpha version of massive FSR for POWHEG

	2015-06-09
	Fix memory leak in interaction for long cascades
	Catch mismatch between beam definition and CIRCE2 spectrum

	2015-06-08
	Automated POWHEG matching: beta version
	Infrastructure for GKS matching
	Alpha version of fixed-order NLO events
	CIRCE2 polarization averaged spectra with
	explicitly polarized beams

	2015-05-12
	Abstract matching type: OO structure for matching/merging

	2015-05-07
	Bug fix in event record WHIZARD-PYTHIA6 transferral
	Gaussian beam spectra for lepton colliders

	##################################################################

	2015-05-02
	RELEASE: version 2.2.6

	2015-05-01
	Models for (unitarized) tensor resonances in VBS

	2015-04-28
	Bug fix in channel weights for event generation.

	2015-04-18
	Improved event record transfer WHIZARD/PYTHIA6

	2015-03-19
	POWHEG matching: alpha version

	##################################################################

	2015-02-27
	RELEASE: version 2.2.5

	2015-02-26
	Abstract types for quantum numbers

	2015-02-25
	Read-in of StdHEP events, self-tests

	2015-02-22
	Bug fix for mother-daughter relations in
	showered/hadronized events

	2015-02-20
	Projection on polarization in intermediate states

	2015-02-13
	Correct treatment of beam remnants in
	event formats (also LC remnants)

	##################################################################

	2015-02-06
	RELEASE: version 2.2.4

	2015-02-06
	Bug fix in event output

	2015-02-05
	LCIO event format supported

	2015-01-30
	Including state matrices in WHIZARD's internal IO
	Versioning for WHIZARD's internal IO
	Libtool update from 2.4.3 to 2.4.5
	LCIO event output (beta version)

	2015-01-27
	Progress on NLO integration
	Fixing a bug for multiple processes in a single
	event file when using beam event files

	2015-01-19
	Bug fix for spin correlations evaluated in the rest
	frame of the mother particle

	2015-01-17
	Regression fix for statically linked processes
	from SARAH and FeynRules

	2015-01-10
	NLO: massive FKS emitters supported (experimental)

	2015-01-06
	MMHT2014 PDF sets included

	2015-01-05
	Handling mass degeneracies in auto_decays

	2014-12-19
	Fixing bug in rescan of event files

	##################################################################

	2014-11-30
	RELEASE: version 2.2.3

	2014-11-29
	Beta version of LO continuum/NLL-threshold
	matched top threshold model for e+e- physics

	2014-11-28
	More internal refactoring: disentanglement of module
	dependencies

	2014-11-21
	OVM: O'Mega Virtual Machine, bytecode instructions
	instead of compiled Fortran code

	2014-11-01
	Higgs Singlet extension model included

	2014-10-18
	Internal restructuring of code; half-way
	WHIZARD main code file disassembled

	2014-07-09
	Alpha version of NLO infrastructure

	##################################################################

	2014-07-06
	RELEASE: version 2.2.2

	2014-07-05
	CIRCE2: correlated LC beam spectra and
	GuineaPig Interface to LC machine parameters

	2014-07-01
	Reading LHEF for decayed/factorized/showered/
	hadronized events

	2014-06-25
	Configure support for GoSAM/Ninja/Form/QGraf

	2014-06-22
	LHAPDF6 interface

	2014-06-18
	Module for automatic generation of
	radiation and loop infrastructure code

	2014-06-11
	Improved internal directory structure

	##################################################################

	2014-06-03
	RELEASE: version 2.2.1

	2014-05-30
	Extensions of internal PDG arrays

	2014-05-26
	FastJet interface

	2014-05-24
	CJ12 PDFs included

	2014-05-20
	Regression fix for external models (via SARAH
	or FeynRules)

	##################################################################

	2014-05-18
	RELEASE: version 2.2.0

	2014-04-11
	Multiple components: inclusive process definitions,
	syntax: process A + B + ...

	2014-03-13
	Improved PS mappings for e+e- ISR
	ILC TDR and CLIC spectra included in CIRCE1

	2014-02-23
	New models: AltH w\ Higgs for exclusion purposes,
	SM_rx for Dim 6-/Dim-8 operators, SSC for
	general strong interactions (w/ Higgs), and
	NoH_rx (w\ Higgs)

	2014-02-14
	Improved s-channel mapping, new on-shell
	production mapping (e.g. Drell-Yan)

	2014-02-03
	PRE-RELEASE: version 2.2.0_beta

	2014-01-26
	O'Mega: Feynman diagram generation possible (again)

	2013-12-16
	HOPPET interface for b parton matching

	2013-11-15
	PRE-RELEASE: version 2.2.0_alpha-4

	2013-10-27
	LHEF standards 1.0/2.0/3.0 implemented

	2013-10-15
	PRE-RELEASE: version 2.2.0_alpha-3

	2013-10-02
	PRE-RELEASE: version 2.2.0_alpha-2

	2013-09-25
	PRE-RELEASE: version 2.2.0_alpha-1

	2013-09-12
	PRE-RELEASE: version 2.2.0_alpha

	2013-09-03
	General 2HDM implemented

	2013-08-18
	Rescanning/recalculating events

	2013-06-07
	Reconstruction of complete event
	from 4-momenta possible

	2013-05-06
	Process library stacks

	2013-05-02
	Process stacks

	2013-04-29
	Single-particle phase space module

	2013-04-26
	Abstract interface for random
	number generator

	2013-04-24
	More object-orientation on modules
	Midpoint-rule integrator

	2013-04-05
	Object-oriented integration and
	event generation

	2013-03-12
	Processes recasted object-oriented:
	MEs, scales, structure functions
	First infrastructure for general Lorentz
	structures

	2013-01-17
	Object-orientated reworking of library and
	process core, more variable internal structure,
	unit tests

	2012-12-14
	Update Pythia version to 6.4.27

	2012-12-04
	Fix the phase in HAZ vertices

	2012-11-21
	First O'Mega unit tests, some infrastructure

	2012-11-13
	Bug fix in anom. HVV Lorentz structures

	##################################################################

	2012-09-18
	RELEASE: version 2.1.1

	2012-09-11
	Model MSSM_Hgg with Hgg and HAA vertices

	2012-09-10
	First version of implementation of multiple
	interactions in WHIZARD

	2012-09-05
	Infrastructure for internal CKKW matching

	2012-09-02
	C, C++, Python API

	2012-07-19
	Fixing particle numbering in HepMC format

	##################################################################

	2012-06-15
	RELEASE: version 2.1.0

	2012-06-14
	Analytical and kT-ordered shower officially
	released
	PYTHIA interface officially released

	2012-05-09
	Intrisince PDFs can be used for showering

	2012-05-04
	Anomalous Higgs couplings a la hep-ph/9902321

	##################################################################

	2012-03-19
	RELEASE: version 2.0.7

	2012-03-15
	Run IDs are available now
	More event variables in analysis
	Modified raw event format (compatibility mode exists)

	2012-03-12
	Bug fix in decay-integration order
	MLM matching steered completely internally now

	2012-03-09
	Special phase space mapping for narrow resonances
	decaying to 4-particle final states with far off-shell
	intermediate states
	Running alphas from PDF collaborations with
	builtin PDFs

	2012-02-16
	Bug fix in cascades decay infrastructure

	2012-02-04
	WHIZARD documentation compatible with TeXLive 2011

	2012-02-01
	Bug fix in FeynRules interface with --prefix flag

	2012-01-29
	Bug fix with name clash of O'Mega variable names

	2012-01-27
	Update internal PYTHIA to version 6.4.26
	Bug fix in LHEF output

	2012-01-21
	Catching stricter automake 1.11.2 rules

	2011-12-23
	Bug fix in decay cascade setup

	2011-12-20
	Bug fix in helicity selection rules

	2011-12-16
	Accuracy goal reimplemented

	2011-12-14
	WHIZARD compatible with TeXLive 2011

	2011-12-09
	Option --user-target added

	##################################################################

	2011-12-07
	RELEASE: version 2.0.6

	2011-12-07
	Bug fixes in SM_top_anom
	Added missing entries to HepMC format

	2011-12-06
	Allow to pass options to O'Mega
	Bug fix for HEPEVT block for showered/hadronized events

	2011-12-01
	Reenabled user plug-in for external code for
	cuts, structure functions, routines etc.

	2011-11-29
	Changed model SM_Higgs for Higgs phenomenology

	2011-11-25
	Supporting a Y, (B-L) Z' model

	2011-11-23
	Make WHIZARD compatible for MAC OS X Lion/XCode 4

	2011-09-25
	WHIZARD paper published: Eur.Phys.J. C71 (2011) 1742

	2011-08-16
	Model SM_QCD: QCD with one EW insertion

	2011-07-19
	Explicit output channel for dvips avoids printing

	2011-07-10
	Test suite for WHIZARD unit tests

	2011-07-01
	Commands for matrix element tests
	More OpenMP parallelization of kinematics
	Added unit tests

	2011-06-23
	Conversion of CIRCE2 from F77 to F90, major
	clean-up

	2011-06-14
	Conversion of CIRCE1 from F77 to F90

	2011-06-10
	OpenMP parallelization of channel kinematics
	(by Matthias Trudewind)

	2011-05-31
	RELEASE: version 1.97

	2011-05-24
	Minor bug fixes: update grids and elsif statement.

	##################################################################

	2011-05-10
	RELEASE: version 2.0.5

	2011-05-09
	Fixed bug in final state flavor sums
	Minor improvements on phase-space setup

	2011-05-05
	Minor bug fixes

	2011-04-15
	WHIZARD as a precompiled 64-bit binary available

	2011-04-06
	Wall clock instead of cpu time for time estimates

	2011-04-05
	Major improvement on the phase space setup

	2011-04-02
	OpenMP parallelization for helicity loop in O'Mega
	matrix elements

	2011-03-31
	Tools for relocating WHIZARD and use in batch
	environments

	2011-03-29
	Completely static builds possible, profiling options

	2011-03-28
	Visualization of integration history

	2011-03-27
	Fixed broken K-matrix implementation

	2011-03-23
	Including the GAMELAN manual in the distribution

	2011-01-26
	WHIZARD analysis can handle hadronized event files

	2011-01-17
	MSTW2008 and CT10 PDF sets included

	2010-12-23
	Inclusion of NMSSM with Hgg couplings

	2010-12-21
	Advanced options for integration passes

	2010-11-16
	WHIZARD supports CTEQ6 and possibly other PDFs
	directly; data files included in the distribution

	##################################################################

	2010-10-26
	RELEASE: version 2.0.4

	2010-10-06
	Bug fix in MSSM implementation

	2010-10-01
	Update to libtool 2.4

	2010-09-29
	Support for anomalous top couplings (form factors etc.)
	Bug fix for running gauge Yukawa SUSY couplings

	2010-09-28
	RELEASE: version 1.96

	2010-09-21
	Beam remnants and pT spectra for lepton collider re-enabled
	Restructuring subevt class

	2010-09-16
	Shower and matching are disabled by default
	PYTHIA as a conditional on these two options

	2010-09-14
	Possibility to read in beam spectra re-enabled (e.g. Guinea
	Pig)

	2010-09-13
	Energy scan as (pseudo-) structure functions re-implemented

	2010-09-10
	CIRCE2 included again in WHIZARD 2 and validated

	2010-09-02
	Re-implementation of asymmetric beam energies and collision
	angles, e-p collisions work, inclusion of a HERA DIS test
	case

	##################################################################

	2010-10-18
	RELEASE: version 2.0.3

	2010-08-08
	Bug in CP-violating anomalous triple TGCs fixed

	2010-08-06
	Solving backwards compatibility problem with O'Caml 3.12.0

	2010-07-12
	Conserved quantum numbers speed up O'Mega code generation

	2010-07-07
	Attaching full ISR/FSR parton shower and MPI/ISR
	module
	Added SM model containing Hgg, HAA, HAZ vertices

	2010-07-02
	Matching output available as LHEF and STDHEP

	2010-06-30
	Various bug fixes, missing files, typos

	2010-06-26
	CIRCE1 completely re-enabled
	Chaining structure functions supported

	2010-06-25
	Partial support for conserved quantum numbers in
	O'Mega

	2010-06-21
	Major upgrade of the graphics package: error bars,
	smarter SINDARIN steering, documentation, and all that...

	2010-06-17
	MLM matching with PYTHIA shower included

	2010-06-16
	Added full CIRCE1 and CIRCE2 versions including
	full documentation and miscellanea to the trunk

	2010-06-12
	User file management supported, improved variable
	and command structure

	2010-05-24
	Improved handling of variables in local command lists

	2010-05-20
	PYTHIA interface re-enabled

	2010-05-19
	ASCII file formats for interfacing ROOT and gnuplot in
	data analysis

	##################################################################

	2010-05-18
	RELEASE: version 2.0.2

	2010-05-14
	Reimplementation of visualization of phase space
	channels
	Minor bug fixes

	2010-05-12
	Improved phase space - elimination of redundancies

	2010-05-08
	Interface for polarization completed: polarized beams etc.

	2010-05-06
	Full quantum numbers appear in process log
	Integration results are usable as user variables
	Communication with external programs

	2010-05-05
	Split module commands into commands, integration,
	simulation modules

	2010-05-04
	FSR+ISR for the first time connected to the WHIZARD 2 core

	##################################################################

	2010-04-25
	RELEASE: version 2.0.1

	2010-04-23
	Automatic compile and integrate if simulate is called
	Minor bug fixes in O'Mega

	2010-04-21
	Checkpointing for event generation
	Flush statements to use WHIZARD inside a pipe

	2010-04-20
	Reimplementation of signal handling in WGIZARD 2.0

	2010-04-19
	VAMP is now a separately configurable and installable unit of
	WHIZARD, included VAMP self-checks
	Support again compilation in quadruple precision

	2010-04-06
	Allow for logarithmic plots in GAMELAN, reimplement the
	possibility to set the number of bins

	2010-04-15
	Improvement on time estimates for event generation

	##################################################################

	2010-04-12
	RELEASE: version 2.0.0

	2010-04-09
	Per default, the code for the amplitudes is subdivided to allow
	faster compiler optimization
	More advanced and unified and straightforward command language
	syntax
	Final bug fixes

	2010-04-07
	Improvement on SINDARIN syntax; printf, sprintf function
	thorugh a C interface

	2010-04-05
	Colorizing DAGs instead of model vertices: speed boost
	in colored code generation

	2010-03-31
	Generalized options for normalization of weighted and
	unweighted events
	Grid and weight histories added again to log files
	Weights can be used in analyses

	2010-03-28
	Cascade decays completely implemented including color and
	spin correlations

	2010-03-07
	Added new WHIZARD header with logo

	2010-03-05
	Removed conflict in O'Mega amplitudes between flavour sums
	and cascades
	StdHEP interface re-implemented

	2010-03-03
	RELEASE: version 2.0.0rc3
	Several bug fixes for preventing abuse in input files
	OpenMP support for amplitudes
	Reimplementation of WHIZARD 1 HEPEVT ASCII event formats
	FeynRules interface successfully passed MSSM test

	2010-02-26
	Eliminating ghost gluons from multi-gluon amplitudes

	2010-02-25
	RELEASE: version 1.95
	HEPEVT format from WHIZARD 1 re-implemented in WHIZARD 2

	2010-02-23
	Running alpha_s implemented in the FeynRules interface

	2010-02-19
	MSSM (semi-) automatized self-tests finalized

	2010-02-17
	RELEASE: version 1.94

	2010-02-16
	Closed memory corruption in WHIZARD 1
	Fixed problems of old MadGraph and CompHep drivers
	with modern compilers
	Uncolored vertex selection rules for colored amplitudes in
	O'Mega

	2010-02-15
	Infrastructure for color correlation computation in O'Mega
	finished
	Forbidden processes are warned about, but treated as non-fatal

	2010-02-14
	Color correlation computation in O'Mega finalized

	2010-02-10
	Improving phase space mappings for identical particles in
	initial and final states
	Introduction of more extended multi-line error message

	2010-02-08
	First O'Caml code for computation of color correlations in
	O'Mega

	2010-02-07
	First MLM matching with e+ e- -> jets

	##################################################################

	2010-02-06
	RELEASE: version 2.0.0rc2

	2010-02-05
	Reconsidered the Makefile structure and more extended tests
	Catch a crash between WHIZARD and O'Mega for forbidden processes
	Tensor products of arbitrary color structures in jet definitions

	2010-02-04
	Color correlation computation in O'Mega finalized

	##################################################################

	2010-02-03
	RELEASE: version 2.0.0rc1

	##################################################################

	2010-01-31
	Reimplemented numerical helicity selection rules
	Phase space functionality of version 1 restored and improved

	2009-12-05
	NMSSM validated with FeynRules in WHIZARD 1 (Felix Braam)

	2009-12-04
	RELEASE: version 2.0.0alpha

	##################################################################

	2009-04-16
	RELEASE: version 1.93

	2009-04-15
	Clean-up of Makefiles and configure scripts
	Reconfiguration of BSM model implementation
	extended supersymmetric models

	2008-12-23
	New model NMSSM (Felix Braam)
	SLHA2 added
	Bug in LHAPDF interface fixed

	2008-08-16
	Bug fixed in K matrix implementation
	Gravitino option in the MSSM added

	2008-03-20
	Improved color and flavor sums

	##################################################################

	2008-03-12
	RELEASE: version 1.92
	LHEF (Les Houches Event File) format added
	Fortran 2003 command-line interface (if supported by the compiler)
	Automated interface to colored models
	More bug fixes and workarounds for compiler compatibility

	##################################################################

	2008-03-06
	RELEASE: version 1.91
	New model K-matrix (resonances and anom. couplings in WW scattering)
	EWA spectrum
	Energy-scan pseudo spectrum
	Preliminary parton shower module (only from final-state quarks)
	Cleanup and improvements of configure process
	Improvements for O'Mega parameter files
	Quadruple precision works again
	More plotting options: lines, symbols, errors
	Documentation with PDF bookmarks enabled
	Various bug fixes

	2007-11-29
	New model UED

	##################################################################

	2007-11-23
	RELEASE: version 1.90
	O'Mega now part of the WHIZARD tree
	Madgraph/CompHEP disabled by default (but still usable)
	Support for LHAPDF (preliminary)
	Added new models: SMZprime, SM_km, Template
	Improved compiler recognition and compatibility
	Minor bug fixes

	##################################################################

	2006-06-15
	RELEASE: version 1.51
	Support for anomaly-type Higgs couplings (to gluon and photon/Z)
	Support for spin 3/2 and spin 2
	New models: Little Higgs (4 versions), toy models for extra dimensions
	and gravitinos
	Fixes to the whizard.nw source documentation to run through LaTeX
	Intel 9.0 bug workaround (deallocation of some arrays)

	2006-05-15
	O'Mega RELEASE: version 0.11
	merged JRR's O'Mega extensions

	##################################################################

	2006-02-07
	RELEASE: version 1.50
	To avoid confusion: Mention outdated manual example in BUGS file
	O'Mega becomes part of the WHIZARD generator

	2006-02-02 [bug fix update]
	Bug fix: spurious error when writing event files for weighted events
	Bug fix: 'r' option for omega produced garbage for some particle names
	Workaround for ifort90 bug (crash when compiling whizard_event)
	Workaround for ifort90 bug (crash when compiling hepevt_common)

	2006-01-27
	Added process definition files for MSSM 2->2 processes
	Included beam recoil for EPA (T.Barklow)
	Updated STDHEP byte counts (for STDHEP 5.04.02)
	Fixed STDHEP compatibility (avoid linking of incomplete .so libs)
	Fixed issue with comphep requiring Xlibs on Opteron
	Fixed issue with ifort 8.x on Opteron (compiling 'signal' interface)
	Fixed color-flow code: was broken for omega with option 'c' and 'w'
	Workaround hacks for g95 compatibility

	2005-11-07
	O'Mega RELEASE: version 0.10
	O'Mega, merged JRR's and WK's color hack for WHiZard
	O'Mega, EXPERIMENTAL: cache fusion tables (required for colors
	a la JRR/WK)
	O'Mega, make JRR's MSSM official

	##################################################################

	2005-10-25
	RELEASE: version 1.43
	Minor fixes in MSSM couplings (Higgs/3rd gen squarks).
	This should be final, since the MSSM results agree now completely
	with Madgraph and Sherpa
	User-defined lower and upper limits for split event file count
	Allow for counters (events, bytes) exceeding $2^{31}$
	Revised checksum treatment and implementation (now MD5)
	Bug fix: missing process energy scale in raw event file

	##################################################################

	2005-09-30
	RELEASE: version 1.42
	Graphical display of integration history ('make history')
	Allow for switching off signals even if supported (configure option)

	2005-09-29
	Revised phase space generation code, in particular for flavor sums
	Negative cut and histogram codes use initial beams instead of
	initial parton momenta. This allows for computing, e.g., E_miss
	Support constant-width and zero-width options for O'Mega
	Width options now denoted by w:X (X=f,c,z). f option obsolescent
	Bug fix: colorized code: flipped indices could screw up result
	Bug fix: O'Mega with 'c' and 'w:f' option together (still some problem)
	Bug fix: dvips on systems where dvips defaults to lpr
	Bug fix: integer overflow if too many events are requested

	2005-07-29
	Allow for 2 -> 1 processes (if structure functions are on)

	2005-07-26
	Fixed and expanded the 'test' matrix element:
	Unit matrix element with option 'u' / default: normalized phase space

	##################################################################

	2005-07-15
	RELEASE: version 1.41
	Bug fix: no result for particle decay processes with width=0
	Bug fix: line breaks in O'Mega files with color decomposition

	2005-06-02
	New self-tests (make test-QED / test-QCD / test-SM)
	check lists of 2->2 processes
	Bug fix: HELAS calling convention for wwwwxx and jwwwxx (4W-Vertex)

	2005-05-25
	Revised Makefile structure
	Eliminated obsolete references to ISAJET/SUSY (superseded by SLHA)

	2005-05-19
	Support for color in O'Mega (using color flow decomposition)
	New model QCD
	Parameter file changes that correspond to replaced SM module in O'Mega
	Bug fixes in MSSM (O'Mega) parameter file

	2005-05-18
	New event file formats, useful for LHC applications:
	ATHENA and Les Houches Accord (external fragmentation)
	Naive (i.e., leading 1/N) color factor now implemented both for
	incoming and outgoing partons

	2005-01-26
	include missing HELAS files for bundle
	pgf90 compatibility issues [note: still internal error in pgf90]

	##################################################################

	2004-12-13
	RELEASE: version 1.40
	compatibility fix: preprocessor marks in helas code now commented out
	minor bug fix: format string in madgraph source

	2004-12-03
	support for arbitray beam energies and directions
	allow for pT kick in structure functions
	bug fix: rounding error could result in zero cross section
	(compiler-dependent)

	2004-10-07
	simulate decay processes
	list fraction (of total width/cross section) instead of efficiency
	in process summary
	new cut/analysis parameters AA, AAD, CTA: absolute polar angle

	2004-10-04
	Replaced Madgraph I by Madgraph II. Main improvement: model no
	longer hardcoded
	introduced parameter reset_seed_each_process (useful for debugging)
	bug fix: color initialization for some processes was undefined

	2004-09-21
	don't compile unix_args module if it is not required

	##################################################################

	2004-09-20
	RELEASE: version 1.30
	g95 compatibility issues resolved
	some (irrelevant) memory leaks closed
	removed obsolete warning in circe1
	manual update (essentially) finished

	2004-08-03
	O'Mega RELEASE: version 0.9
	O'Mega, src/trie.mli, src/trie.ml: make interface compatible with
	the O'Caml 3.08 library (remains compatible with older
	versions). Implementation of unused functions still
	incomplete.

	2004-07-26
	minor fixes and improvements in make process

	2004-06-29
	workarounds for new Intel compiler bugs ...
	no rebuild of madgraph/comphep executables after 'make clean'
	bug fix in phase space routine:
	wrong energy for massive initial particles
	bug fix in (new) model interface: name checks for antiparticles
	pre-run checks for comphep improved
	ww-strong model file extended
	Model files particle name fixes, chep SM vertices included

	2004-06-22
	O'Mega RELEASE: version 0.8
	O'Mega MSSM: sign of W+/W-/A and W+/W-/Z couplings

	2004-05-05
	Fixed bug in PDFLIB interface: p+pbar was initialized as p+p (ThO)
	NAG compiler: set number of continuation lines to 200 as default
	Extended format for cross section summary; appears now in whizard.out
	Fixed 'bundle' feature

	2004-04-28
	Fixed compatibility with revised O'Mega SM_ac model
	Fixed problem with x=0 or x=1 when calling PDFLIB (ThO)
	Fixed bug in comphep module: Vtb was overlooked

	##################################################################

	2004-04-15
	RELEASE: version 1.28
	Fixed bug: Color factor was missing for O'Mega processes with
	four quarks and more
	Manual partially updated

	2004-04-08
	Support for grid files in binary format
	New default value show_histories=F (reduce output file size)
	Revised phase space switches: removed annihilation_lines,
	removed s_channel_resonance, changed meaning of
	extra_off_shell_lines, added show_deleted_channels
	Bug fixed which lead to omission of some phase space channels
	Color flow guessed only if requested by guess_color_flow

	2004-03-10
	New model interface: Only one model name specified in whizard.prc
	All model-dependent files reside in conf/models (modellib removed)

	2004-03-03
	Support for input/output in SUSY Les Houches Accord format
	Split event files if requested
	Support for overall time limit
	Support for CIRCE and CIRCE2 generator mode
	Support for reading beam events from file

	2004-02-05
	Fixed compiler problems with Intel Fortran 7.1 and 8.0
	Support for catching signals

	##################################################################

	2003-08-06
	RELEASE: version 1.27
	User-defined PDF libraries as an alternative to the standard PDFLIB

	2003-07-23
	Revised phase space module: improved mappings for massless particles,
	equivalences of phase space channels are exploited
	Improved mapping for PDF (hadron colliders)
	Madgraph module: increased max number of color flows from 250 to 1000

	##################################################################

	2003-06-23
	RELEASE: version 1.26
	CIRCE2 support
	Fixed problem with 'TC' integer kind [Intel compiler complained]

	2003-05-28
	Support for drawing histograms of grids
	Bug fixes for MSSM definitions

	##################################################################

	2003-05-22
	RELEASE: version 1.25
	Experimental MSSM support with ISAJET interface
	Improved capabilities of generating/analyzing weighted events
	Optional drawing phase space diagrams using FeynMF

	##################################################################

	2003-01-31
	RELEASE: version 1.24
	A few more fixes and workarounds (Intel and Lahey compiler)

	2003-01-15
	Fixes and workarounds needed for WHIZARD to run with Intel compiler
	Command-line option interface for the Lahey compiler

	Bug fix: problem with reading whizard.phs

	##################################################################

	2002-12-10
	RELEASE: version 1.23

	Command-line options (on some systems)

	Allow for initial particles in the event record, ordered:
	[beams, initials] - [remnants] - outgoing partons

	Support for PYTHIA 6.2: Les Houches external process interface
	String pythia_parameters can be up to 1000 characters long
	Select color flow states in (internal) analysis
	Bug fix in color flow content of raw event files

	Support for transversal polarization of fermion beams
	Cut codes: PHI now for absolute azimuthal angle, DPHI for distance
	'Test' matrix elements optionally respect polarization

	User-defined code can be inserted for spectra, structure functions
	and fragmentation

	Time limits can be specified for adaptation and simulation
	User-defined file names and file directory
	Initial weights in input file no longer supported

	Bug fix in MadGraph (wave function counter could overflow)

	Bug fix: Gamelan (graphical analysis) was not built if noweb absent

	##################################################################

	2002-03-16
	RELEASE: version 1.22
	Allow for beam remnants in the event record

	2002-03-01
	Handling of aliases in whizard.prc fixed (aliases are whole tokens)

	2002-02-28
	Optimized phase space handling routines
	(total execution time reduced by 20-60%, depending on process)

	##################################################################

	2002-02-26
	RELEASE: version 1.21
	Fixed ISR formula (ISR was underestimated in previous versions).
	New version includes ISR in leading-log approximation up to
	third order. Parameter ISR_sqrts renamed to ISR_scale.

	##################################################################

	2002-02-19
	RELEASE: version 1.20
	New process-generating method 'test' (dummy matrix element)
	Compatibility with autoconf 2.50 and current O'Mega version

	2002-02-05
	Prevent integration channels from being dropped (optionally)
	New internal mapping for structure functions improves performance
	Old whizard.phx file deleted after recompiling (could cause trouble)

	2002-01-24
	Support for user-defined cuts and matrix element reweighting
	STDHEP output now written by write_events_format=20 (was 3)

	2002-01-16
	Improved structure function handling; small changes in user interface:
	new parameter structured_beams in &process_input
	parameter fixed_energy in &beam_input removed
	Support for multiple initial states
	Eta-phi (cone) cut possible (hadron collider applications)
	Fixed bug: Whizard library was not always recompiled when necessary
	Fixed bug: Default cuts were insufficient in some cases
	Fixed bug: Unusable phase space mappings generated in some cases

	2001-12-06
	Reorganized document source

	2001-12-05
	Preliminary CIRCE2 support (no functionality yet)

	2001-11-27
	Intel compiler support (does not yet work because of compiler bugs)
	New cut and analysis mode cos-theta* and related
	Fixed circular jetset_interface dependency warning
	Some broadcast routines removed (parallel support disabled anyway)
	Minor shifts in cleanup targets (Makefiles)
	Modified library search, check for pdflib8*

	2001-08-06
	Fixed bug: I/O unit number could be undefined when reading phase space
	Fixed bug: Unitialized variable could cause segfault when
	event generation was disabled
	Fixed bug: Undefined subroutine in CIRCE replacement module
	Enabled feature: TGCs in O'Mega (not yet CompHEP!) matrix elements
	(CompHEP model sm-GF #5, O'Mega model SM_ac)
	Fixed portability issue: Makefile did rely on PWD environment variable
	Fixed portability issue: PYTHIA library search ambiguity resolved

	2001-08-01
	Default whizard.prc and whizard.in depend on activated modules
	Fixed bug: TEX=latex was not properly enabled when making plots

	2001-07-20
	Fixed output settings in PERL script calls
	Cache enabled in various configure checks

	2001-07-13
	Support for multiple processes in a single WHIZARD run. The
	integrations are kept separate, but the generated events are mixed
	The whizard.evx format has changed (incompatible), including now
	the color flow information for PYTHIA fragmentation
	Output files are now process-specific, except for the event file
	Phase space file whizard.phs (if present) is used only as input,
	program-generated phase space is now in whizard.phx

	2001-07-10
	Bug fix: Undefined parameters in parameters_SM_ac.f90 removed

	2001-07-04
	Bug fix: Compiler options for the case OMEGA is disabled
	Small inconsistencies in whizard.out format fixed

	2001-07-01
	Workaround for missing PDFLIB dummy routines in PYTHIA library

	##################################################################

	2001-06-30
	RELEASE: version 1.13
	Default path /cern/pro/lib in configure script

	2001-06-20
	New fragmentation option: Interface for PYTHIA with full color flow
	information, beam remnants etc.

	2001-06-18
	Severe bug fixed in madgraph interface: 3-gluon coupling was missing
	Enabled color flow information in madgraph

	2001-06-11
	VAMP interface module rewritten
	Revised output format: Multiple VAMP iterations count as one WHIZARD
	iteration in integration passes 1 and 3
	Improved message and error handling
	Bug fix in VAMP: handle exceptional cases in rebinning_weights

	2001-05-31
	new parameters for grid adaptation: accuracy_goal and efficiency_goal

	##################################################################

	2001-05-29
	RELEASE: version 1.12
	bug fixes (compilation problems): deleted/modified unused functions

	2001-05-16
	diagram selection improved and documented

	2001-05-06
	allow for disabling packages during configuration

	2001-05-03
	slight changes in whizard.out format; manual extended

	##################################################################

	2001-04-20
	RELEASE: version 1.11
	fixed some configuration and compilation problems (PDFLIB etc.)

	2001-04-18
	linked PDFLIB: support for quark/gluon structure functions

	2001-04-05
	parameter interface written by PERL script
	SM_ac model file: fixed error in continuation line

	2001-03-13
	O'Mega, O'Caml 3.01: incompatible changes
	O'Mega, src/trie.mli: add covariance annotation to T.t
	This breaks O'Caml 3.00, but is required for O'Caml 3.01.
	O'Mega, many instances: replace `sig include Module.T end' by
	`Module.T', since the bug is fixed in O'Caml 3.01

	2001-02-28
	O'Mega, src/model.mli:
	new field Model.vertices required for model functors, will
	retire Model.fuse2, Model.fuse3, Model.fusen soon.

	##################################################################

	2001-03-27
	RELEASE: version 1.10
	reorganized the modules as libraries
	linked PYTHIA: support for parton fragmentation

	2000-12-14
	fixed some configuration problems (if noweb etc. are absent)

	##################################################################

	2000-12-01
	RELEASE of first public version: version 1.00beta

File Metadata

Mime Type: application/octet-stream
Expires: Thu, May 16, 12:14 PM (1 d, 23 h)
Storage Engine: chunks
Storage Format: Chunks
Storage Handle: JlYyDsCgTxUu
Default Alt Text: (5 MB)

Offset	End	Complete
0	4194304	Yes
4194304	5300283	Yes

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions